{-
    Copyright 2022 Vidar Holen

    This file is part of ShellCheck.
    https://www.shellcheck.net

    ShellCheck is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    ShellCheck is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}

-- Constructs a Control Flow Graph from an AST
module ShellCheck.CFG (
    CFNode (..),
    CFEdge (..),
    CFEffect (..),
    CFStringPart (..),
    CFVariableProp (..),
    CFGResult (..),
    CFValue (..),
    CFGraph,
    CFGParameters (..),
    IdTagged (..),
    Scope (..),
    buildGraph
    , ShellCheck.CFG.runTests -- STRIP
    )
  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 qualified Data.List.NonEmpty as NE
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 -- STRIP

import Test.QuickCheck.All (forAllProperties)
import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess)


-- Our basic Graph type
type CFGraph = G.Gr CFNode CFEdge

-- Node labels in a Control Flow Graph
data CFNode =
    -- A no-op node for structural purposes
    CFStructuralNode
    -- A no-op for graph inspection purposes
    | CFEntryPoint String
    -- Drop current prefix assignments
    | CFDropPrefixAssignments
    -- A node with a certain effect on program state
    | CFApplyEffects [IdTagged CFEffect]
    -- The execution of a command or function by literal string if possible
    | CFExecuteCommand (Maybe String)
    -- Execute a subshell. These are represented by disjoint graphs just like
    -- functions, but they don't require any form of name resolution
    | CFExecuteSubshell String Node Node
    -- Assignment of $?
    | CFSetExitCode Id
    -- The virtual 'exit' at the natural end of a subshell
    | CFImpliedExit
    -- An exit statement resolvable at CFG build time
    | CFResolvedExit
    -- An exit statement only resolvable at DFA time
    | CFUnresolvedExit
    -- An unreachable node, serving as the unconnected end point of a range
    | CFUnreachable
    -- Assignment of $!
    | CFSetBackgroundPid Id
  deriving (CFNode -> CFNode -> Bool
(CFNode -> CFNode -> Bool)
-> (CFNode -> CFNode -> Bool) -> Eq CFNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CFNode -> CFNode -> Bool
== :: CFNode -> CFNode -> Bool
$c/= :: CFNode -> CFNode -> Bool
/= :: CFNode -> CFNode -> Bool
Eq, Eq CFNode
Eq CFNode =>
(CFNode -> CFNode -> Ordering)
-> (CFNode -> CFNode -> Bool)
-> (CFNode -> CFNode -> Bool)
-> (CFNode -> CFNode -> Bool)
-> (CFNode -> CFNode -> Bool)
-> (CFNode -> CFNode -> CFNode)
-> (CFNode -> CFNode -> CFNode)
-> Ord 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
$ccompare :: CFNode -> CFNode -> Ordering
compare :: CFNode -> CFNode -> Ordering
$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
>= :: CFNode -> CFNode -> Bool
$cmax :: CFNode -> CFNode -> CFNode
max :: CFNode -> CFNode -> CFNode
$cmin :: CFNode -> CFNode -> CFNode
min :: CFNode -> CFNode -> CFNode
Ord, Node -> CFNode -> ShowS
[CFNode] -> ShowS
CFNode -> String
(Node -> CFNode -> ShowS)
-> (CFNode -> String) -> ([CFNode] -> ShowS) -> Show CFNode
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> CFNode -> ShowS
showsPrec :: Node -> CFNode -> ShowS
$cshow :: CFNode -> String
show :: CFNode -> String
$cshowList :: [CFNode] -> ShowS
showList :: [CFNode] -> ShowS
Show, (forall x. CFNode -> Rep CFNode x)
-> (forall x. Rep CFNode x -> CFNode) -> Generic CFNode
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
$cfrom :: forall x. CFNode -> Rep CFNode x
from :: forall x. CFNode -> Rep CFNode x
$cto :: forall x. Rep CFNode x -> CFNode
to :: forall x. Rep CFNode x -> CFNode
Generic, CFNode -> ()
(CFNode -> ()) -> NFData CFNode
forall a. (a -> ()) -> NFData a
$crnf :: CFNode -> ()
rnf :: CFNode -> ()
NFData)

-- Edge labels in a Control Flow Graph
data CFEdge =
    CFEErrExit
    -- Regular control flow edge
    | CFEFlow
    -- An edge that a human might think exists (e.g. from a backgrounded process to its parent)
    | CFEFalseFlow
    -- An edge followed on exit
    | CFEExit
  deriving (CFEdge -> CFEdge -> Bool
(CFEdge -> CFEdge -> Bool)
-> (CFEdge -> CFEdge -> Bool) -> Eq CFEdge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CFEdge -> CFEdge -> Bool
== :: CFEdge -> CFEdge -> Bool
$c/= :: CFEdge -> CFEdge -> Bool
/= :: CFEdge -> CFEdge -> Bool
Eq, Eq CFEdge
Eq CFEdge =>
(CFEdge -> CFEdge -> Ordering)
-> (CFEdge -> CFEdge -> Bool)
-> (CFEdge -> CFEdge -> Bool)
-> (CFEdge -> CFEdge -> Bool)
-> (CFEdge -> CFEdge -> Bool)
-> (CFEdge -> CFEdge -> CFEdge)
-> (CFEdge -> CFEdge -> CFEdge)
-> Ord 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
$ccompare :: CFEdge -> CFEdge -> Ordering
compare :: CFEdge -> CFEdge -> Ordering
$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
>= :: CFEdge -> CFEdge -> Bool
$cmax :: CFEdge -> CFEdge -> CFEdge
max :: CFEdge -> CFEdge -> CFEdge
$cmin :: CFEdge -> CFEdge -> CFEdge
min :: CFEdge -> CFEdge -> CFEdge
Ord, Node -> CFEdge -> ShowS
[CFEdge] -> ShowS
CFEdge -> String
(Node -> CFEdge -> ShowS)
-> (CFEdge -> String) -> ([CFEdge] -> ShowS) -> Show CFEdge
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> CFEdge -> ShowS
showsPrec :: Node -> CFEdge -> ShowS
$cshow :: CFEdge -> String
show :: CFEdge -> String
$cshowList :: [CFEdge] -> ShowS
showList :: [CFEdge] -> ShowS
Show, (forall x. CFEdge -> Rep CFEdge x)
-> (forall x. Rep CFEdge x -> CFEdge) -> Generic CFEdge
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
$cfrom :: forall x. CFEdge -> Rep CFEdge x
from :: forall x. CFEdge -> Rep CFEdge x
$cto :: forall x. Rep CFEdge x -> CFEdge
to :: forall x. Rep CFEdge x -> CFEdge
Generic, CFEdge -> ()
(CFEdge -> ()) -> NFData CFEdge
forall a. (a -> ()) -> NFData a
$crnf :: CFEdge -> ()
rnf :: CFEdge -> ()
NFData)

-- Actions we track
data CFEffect =
    CFSetProps (Maybe Scope) String (S.Set CFVariableProp)
    | CFUnsetProps (Maybe 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
    -- Usage implies that this is an array (e.g. it's expanded with index)
    | CFHintArray String
    -- Operation implies that the variable will be defined (e.g. [ -z "$var" ])
    | CFHintDefined String
  deriving (CFEffect -> CFEffect -> Bool
(CFEffect -> CFEffect -> Bool)
-> (CFEffect -> CFEffect -> Bool) -> Eq CFEffect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CFEffect -> CFEffect -> Bool
== :: CFEffect -> CFEffect -> Bool
$c/= :: CFEffect -> CFEffect -> Bool
/= :: CFEffect -> CFEffect -> Bool
Eq, Eq CFEffect
Eq CFEffect =>
(CFEffect -> CFEffect -> Ordering)
-> (CFEffect -> CFEffect -> Bool)
-> (CFEffect -> CFEffect -> Bool)
-> (CFEffect -> CFEffect -> Bool)
-> (CFEffect -> CFEffect -> Bool)
-> (CFEffect -> CFEffect -> CFEffect)
-> (CFEffect -> CFEffect -> CFEffect)
-> Ord 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
$ccompare :: CFEffect -> CFEffect -> Ordering
compare :: CFEffect -> CFEffect -> Ordering
$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
>= :: CFEffect -> CFEffect -> Bool
$cmax :: CFEffect -> CFEffect -> CFEffect
max :: CFEffect -> CFEffect -> CFEffect
$cmin :: CFEffect -> CFEffect -> CFEffect
min :: CFEffect -> CFEffect -> CFEffect
Ord, Node -> CFEffect -> ShowS
[CFEffect] -> ShowS
CFEffect -> String
(Node -> CFEffect -> ShowS)
-> (CFEffect -> String) -> ([CFEffect] -> ShowS) -> Show CFEffect
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> CFEffect -> ShowS
showsPrec :: Node -> CFEffect -> ShowS
$cshow :: CFEffect -> String
show :: CFEffect -> String
$cshowList :: [CFEffect] -> ShowS
showList :: [CFEffect] -> ShowS
Show, (forall x. CFEffect -> Rep CFEffect x)
-> (forall x. Rep CFEffect x -> CFEffect) -> Generic CFEffect
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
$cfrom :: forall x. CFEffect -> Rep CFEffect x
from :: forall x. CFEffect -> Rep CFEffect x
$cto :: forall x. Rep CFEffect x -> CFEffect
to :: forall x. Rep CFEffect x -> CFEffect
Generic, CFEffect -> ()
(CFEffect -> ()) -> NFData CFEffect
forall a. (a -> ()) -> NFData a
$crnf :: CFEffect -> ()
rnf :: CFEffect -> ()
NFData)

data IdTagged a = IdTagged Id a
  deriving (IdTagged a -> IdTagged a -> Bool
(IdTagged a -> IdTagged a -> Bool)
-> (IdTagged a -> IdTagged a -> Bool) -> Eq (IdTagged a)
forall a. Eq a => IdTagged a -> IdTagged a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: IdTagged a -> IdTagged a -> Bool
Eq, Eq (IdTagged a)
Eq (IdTagged a) =>
(IdTagged a -> IdTagged a -> Ordering)
-> (IdTagged a -> IdTagged a -> Bool)
-> (IdTagged a -> IdTagged a -> Bool)
-> (IdTagged a -> IdTagged a -> Bool)
-> (IdTagged a -> IdTagged a -> Bool)
-> (IdTagged a -> IdTagged a -> IdTagged a)
-> (IdTagged a -> IdTagged a -> IdTagged a)
-> Ord (IdTagged a)
IdTagged a -> IdTagged a -> Bool
IdTagged a -> IdTagged a -> Ordering
IdTagged a -> IdTagged a -> IdTagged a
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
$ccompare :: forall a. Ord a => IdTagged a -> IdTagged a -> Ordering
compare :: IdTagged a -> IdTagged a -> Ordering
$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
>= :: IdTagged a -> IdTagged a -> Bool
$cmax :: forall a. Ord a => IdTagged a -> IdTagged a -> IdTagged a
max :: IdTagged a -> IdTagged a -> IdTagged a
$cmin :: forall a. Ord a => IdTagged a -> IdTagged a -> IdTagged a
min :: IdTagged a -> IdTagged a -> IdTagged a
Ord, Node -> IdTagged a -> ShowS
[IdTagged a] -> ShowS
IdTagged a -> String
(Node -> IdTagged a -> ShowS)
-> (IdTagged a -> String)
-> ([IdTagged a] -> ShowS)
-> Show (IdTagged a)
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
$cshowsPrec :: forall a. Show a => Node -> IdTagged a -> ShowS
showsPrec :: Node -> IdTagged a -> ShowS
$cshow :: forall a. Show a => IdTagged a -> String
show :: IdTagged a -> String
$cshowList :: forall a. Show a => [IdTagged a] -> ShowS
showList :: [IdTagged a] -> ShowS
Show, (forall x. IdTagged a -> Rep (IdTagged a) x)
-> (forall x. Rep (IdTagged a) x -> IdTagged a)
-> Generic (IdTagged a)
forall x. Rep (IdTagged a) x -> IdTagged a
forall x. IdTagged a -> Rep (IdTagged a) x
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
$cfrom :: forall a x. IdTagged a -> Rep (IdTagged a) x
from :: forall x. IdTagged a -> Rep (IdTagged a) x
$cto :: forall a x. Rep (IdTagged a) x -> IdTagged a
to :: forall x. Rep (IdTagged a) x -> IdTagged a
Generic, IdTagged a -> ()
(IdTagged a -> ()) -> NFData (IdTagged a)
forall a. NFData a => IdTagged a -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall a. NFData a => IdTagged a -> ()
rnf :: IdTagged a -> ()
NFData)

-- Where a variable's value comes from
data CFValue =
    -- The special 'uninitialized' value
    CFValueUninitialized
    -- An arbitrary array value
    | CFValueArray
    -- An arbitrary string value
    | CFValueString
    -- An arbitrary integer
    | CFValueInteger
    -- Token 'Id' concatenates and assigns the given parts
    | CFValueComputed Id [CFStringPart]
  deriving (CFValue -> CFValue -> Bool
(CFValue -> CFValue -> Bool)
-> (CFValue -> CFValue -> Bool) -> Eq CFValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CFValue -> CFValue -> Bool
== :: CFValue -> CFValue -> Bool
$c/= :: CFValue -> CFValue -> Bool
/= :: CFValue -> CFValue -> Bool
Eq, Eq CFValue
Eq CFValue =>
(CFValue -> CFValue -> Ordering)
-> (CFValue -> CFValue -> Bool)
-> (CFValue -> CFValue -> Bool)
-> (CFValue -> CFValue -> Bool)
-> (CFValue -> CFValue -> Bool)
-> (CFValue -> CFValue -> CFValue)
-> (CFValue -> CFValue -> CFValue)
-> Ord 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
$ccompare :: CFValue -> CFValue -> Ordering
compare :: CFValue -> CFValue -> Ordering
$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
>= :: CFValue -> CFValue -> Bool
$cmax :: CFValue -> CFValue -> CFValue
max :: CFValue -> CFValue -> CFValue
$cmin :: CFValue -> CFValue -> CFValue
min :: CFValue -> CFValue -> CFValue
Ord, Node -> CFValue -> ShowS
[CFValue] -> ShowS
CFValue -> String
(Node -> CFValue -> ShowS)
-> (CFValue -> String) -> ([CFValue] -> ShowS) -> Show CFValue
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> CFValue -> ShowS
showsPrec :: Node -> CFValue -> ShowS
$cshow :: CFValue -> String
show :: CFValue -> String
$cshowList :: [CFValue] -> ShowS
showList :: [CFValue] -> ShowS
Show, (forall x. CFValue -> Rep CFValue x)
-> (forall x. Rep CFValue x -> CFValue) -> Generic CFValue
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
$cfrom :: forall x. CFValue -> Rep CFValue x
from :: forall x. CFValue -> Rep CFValue x
$cto :: forall x. Rep CFValue x -> CFValue
to :: forall x. Rep CFValue x -> CFValue
Generic, CFValue -> ()
(CFValue -> ()) -> NFData CFValue
forall a. (a -> ()) -> NFData a
$crnf :: CFValue -> ()
rnf :: CFValue -> ()
NFData)

-- Simplified computed strings
data CFStringPart =
    -- A known literal string value, like 'foo'
    CFStringLiteral String
    -- The contents of a variable, like $foo (may not be a string)
    | CFStringVariable String
    -- An value that is unknown but an integer
    | CFStringInteger
    -- An unknown string value, for things we can't handle
    | CFStringUnknown
  deriving (CFStringPart -> CFStringPart -> Bool
(CFStringPart -> CFStringPart -> Bool)
-> (CFStringPart -> CFStringPart -> Bool) -> Eq CFStringPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CFStringPart -> CFStringPart -> Bool
== :: CFStringPart -> CFStringPart -> Bool
$c/= :: CFStringPart -> CFStringPart -> Bool
/= :: CFStringPart -> CFStringPart -> Bool
Eq, Eq CFStringPart
Eq CFStringPart =>
(CFStringPart -> CFStringPart -> Ordering)
-> (CFStringPart -> CFStringPart -> Bool)
-> (CFStringPart -> CFStringPart -> Bool)
-> (CFStringPart -> CFStringPart -> Bool)
-> (CFStringPart -> CFStringPart -> Bool)
-> (CFStringPart -> CFStringPart -> CFStringPart)
-> (CFStringPart -> CFStringPart -> CFStringPart)
-> Ord 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
$ccompare :: CFStringPart -> CFStringPart -> Ordering
compare :: CFStringPart -> CFStringPart -> Ordering
$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
>= :: CFStringPart -> CFStringPart -> Bool
$cmax :: CFStringPart -> CFStringPart -> CFStringPart
max :: CFStringPart -> CFStringPart -> CFStringPart
$cmin :: CFStringPart -> CFStringPart -> CFStringPart
min :: CFStringPart -> CFStringPart -> CFStringPart
Ord, Node -> CFStringPart -> ShowS
[CFStringPart] -> ShowS
CFStringPart -> String
(Node -> CFStringPart -> ShowS)
-> (CFStringPart -> String)
-> ([CFStringPart] -> ShowS)
-> Show CFStringPart
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> CFStringPart -> ShowS
showsPrec :: Node -> CFStringPart -> ShowS
$cshow :: CFStringPart -> String
show :: CFStringPart -> String
$cshowList :: [CFStringPart] -> ShowS
showList :: [CFStringPart] -> ShowS
Show, (forall x. CFStringPart -> Rep CFStringPart x)
-> (forall x. Rep CFStringPart x -> CFStringPart)
-> Generic CFStringPart
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
$cfrom :: forall x. CFStringPart -> Rep CFStringPart x
from :: forall x. CFStringPart -> Rep CFStringPart x
$cto :: forall x. Rep CFStringPart x -> CFStringPart
to :: forall x. Rep CFStringPart x -> CFStringPart
Generic, CFStringPart -> ()
(CFStringPart -> ()) -> NFData CFStringPart
forall a. (a -> ()) -> NFData a
$crnf :: CFStringPart -> ()
rnf :: CFStringPart -> ()
NFData)

-- The properties of a variable
data CFVariableProp = CFVPExport | CFVPArray | CFVPAssociative | CFVPInteger
  deriving (CFVariableProp -> CFVariableProp -> Bool
(CFVariableProp -> CFVariableProp -> Bool)
-> (CFVariableProp -> CFVariableProp -> Bool) -> Eq CFVariableProp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CFVariableProp -> CFVariableProp -> Bool
== :: CFVariableProp -> CFVariableProp -> Bool
$c/= :: CFVariableProp -> CFVariableProp -> Bool
/= :: CFVariableProp -> CFVariableProp -> Bool
Eq, Eq CFVariableProp
Eq CFVariableProp =>
(CFVariableProp -> CFVariableProp -> Ordering)
-> (CFVariableProp -> CFVariableProp -> Bool)
-> (CFVariableProp -> CFVariableProp -> Bool)
-> (CFVariableProp -> CFVariableProp -> Bool)
-> (CFVariableProp -> CFVariableProp -> Bool)
-> (CFVariableProp -> CFVariableProp -> CFVariableProp)
-> (CFVariableProp -> CFVariableProp -> CFVariableProp)
-> Ord 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
$ccompare :: CFVariableProp -> CFVariableProp -> Ordering
compare :: CFVariableProp -> CFVariableProp -> Ordering
$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
>= :: CFVariableProp -> CFVariableProp -> Bool
$cmax :: CFVariableProp -> CFVariableProp -> CFVariableProp
max :: CFVariableProp -> CFVariableProp -> CFVariableProp
$cmin :: CFVariableProp -> CFVariableProp -> CFVariableProp
min :: CFVariableProp -> CFVariableProp -> CFVariableProp
Ord, Node -> CFVariableProp -> ShowS
[CFVariableProp] -> ShowS
CFVariableProp -> String
(Node -> CFVariableProp -> ShowS)
-> (CFVariableProp -> String)
-> ([CFVariableProp] -> ShowS)
-> Show CFVariableProp
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> CFVariableProp -> ShowS
showsPrec :: Node -> CFVariableProp -> ShowS
$cshow :: CFVariableProp -> String
show :: CFVariableProp -> String
$cshowList :: [CFVariableProp] -> ShowS
showList :: [CFVariableProp] -> ShowS
Show, (forall x. CFVariableProp -> Rep CFVariableProp x)
-> (forall x. Rep CFVariableProp x -> CFVariableProp)
-> Generic CFVariableProp
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
$cfrom :: forall x. CFVariableProp -> Rep CFVariableProp x
from :: forall x. CFVariableProp -> Rep CFVariableProp x
$cto :: forall x. Rep CFVariableProp x -> CFVariableProp
to :: forall x. Rep CFVariableProp x -> CFVariableProp
Generic, CFVariableProp -> ()
(CFVariableProp -> ()) -> NFData CFVariableProp
forall a. (a -> ()) -> NFData a
$crnf :: CFVariableProp -> ()
rnf :: CFVariableProp -> ()
NFData)

-- Options when generating CFG
data CFGParameters = CFGParameters {
    -- Whether the last element in a pipeline runs in the current shell
    CFGParameters -> Bool
cfLastpipe :: Bool,
    -- Whether all elements in a pipeline count towards the exit status
    CFGParameters -> Bool
cfPipefail :: Bool
}

data CFGResult = CFGResult {
    -- The graph itself
    CFGResult -> CFGraph
cfGraph :: CFGraph,
    -- Map from Id to nominal start&end node (i.e. assuming normal execution without exits)
    CFGResult -> Map Id (Node, Node)
cfIdToRange :: M.Map Id (Node, Node),
    -- A set of all nodes belonging to an Id, recursively
    CFGResult -> Map Id (Set Node)
cfIdToNodes :: M.Map Id (S.Set Node),
    -- An array (from,to) saying whether 'from' postdominates 'to'
    CFGResult -> Array Node [Node]
cfPostDominators :: Array Node [Node]
}
  deriving (Node -> CFGResult -> ShowS
[CFGResult] -> ShowS
CFGResult -> String
(Node -> CFGResult -> ShowS)
-> (CFGResult -> String)
-> ([CFGResult] -> ShowS)
-> Show CFGResult
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> CFGResult -> ShowS
showsPrec :: Node -> CFGResult -> ShowS
$cshow :: CFGResult -> String
show :: CFGResult -> String
$cshowList :: [CFGResult] -> ShowS
showList :: [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) = RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
-> CFContext
-> Node
-> (Node,
    ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
     [(Id, Node)]))
forall r w s a. RWS r w s a -> r -> s -> (s, w)
execRWS (Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
buildRoot Token
root) (CFGParameters -> CFContext
newCFContext CFGParameters
params) Node
0
        ([LNode CFNode]
nodes, [LEdge CFEdge]
edges, [(Id, (Node, Node))]
mapping, [(Id, Node)]
association) =
--            renumberTopologically $
                ([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 = [(Id, (Node, Node))] -> Map Id (Node, Node)
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
CFEExit -> Bool
True; CFEdge
_ -> Bool
False
        onlyRealEdges :: [LEdge CFEdge]
onlyRealEdges = (LEdge CFEdge -> Bool) -> [LEdge CFEdge] -> [LEdge CFEdge]
forall a. (a -> Bool) -> [a] -> [a]
filter LEdge CFEdge -> Bool
forall {a} {b}. (a, b, CFEdge) -> Bool
isRealEdge [LEdge CFEdge]
edges
        (Node
_, Node
mainExit) = Maybe (Node, Node) -> (Node, Node)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Node, Node) -> (Node, Node))
-> Maybe (Node, Node) -> (Node, Node)
forall a b. (a -> b) -> a -> b
$ Id -> Map Id (Node, Node) -> Maybe (Node, Node)
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 = [LNode CFNode] -> [LEdge CFEdge] -> CFGraph
forall a b. [LNode a] -> [LEdge b] -> Gr a b
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 = (Set Node -> Set Node -> Set Node)
-> [(Id, Set Node)] -> Map Id (Set Node)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Set Node -> Set Node -> Set Node
forall a. Ord a => Set a -> Set a -> Set a
S.union ([(Id, Set Node)] -> Map Id (Set Node))
-> [(Id, Set Node)] -> Map Id (Set Node)
forall a b. (a -> b) -> a -> b
$ ((Id, Node) -> (Id, Set Node)) -> [(Id, Node)] -> [(Id, Set Node)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, Node
n) -> (Id
id, Node -> Set Node
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 (CFGraph -> Array Node [Node]) -> CFGraph -> Array Node [Node]
forall a b. (a -> b) -> a -> b
$ [LNode CFNode] -> [LEdge CFEdge] -> CFGraph
forall a b. [LNode a] -> [LEdge b] -> Gr 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) =
    (
        (LNode CFNode -> LNode CFNode) -> [LNode CFNode] -> [LNode CFNode]
forall a b. (a -> b) -> [a] -> [b]
map (Map Node Node -> LNode CFNode -> LNode CFNode
remapNode Map Node Node
remap) [LNode CFNode]
nodes,
        (LEdge CFEdge -> LEdge CFEdge) -> [LEdge CFEdge] -> [LEdge CFEdge]
forall a b. (a -> b) -> [a] -> [b]
map (Map Node Node -> LEdge CFEdge -> LEdge CFEdge
remapEdge Map Node Node
remap) [LEdge CFEdge]
edges,
        ((Id, (Node, Node)) -> (Id, (Node, Node)))
-> [(Id, (Node, Node))] -> [(Id, (Node, Node))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, (Node
a,Node
b)) -> (Id
id, (Map Node Node -> Node -> Node
forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
remap Node
a, Map Node Node -> Node -> Node
forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
remap Node
b))) [(Id, (Node, Node))]
mapping,
        ((Id, Node) -> (Id, Node)) -> [(Id, Node)] -> [(Id, Node)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, Node
n) -> (Id
id, Map Node Node -> Node -> Node
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 ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
 [(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
-> Bool
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

-- Renumber the graph for prettiness, so there are no gaps in node numbers
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 = [(Node, Node)] -> Map Node Node
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (([Node] -> [Node] -> [(Node, Node)])
-> [Node] -> [Node] -> [(Node, Node)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Node] -> [Node] -> [(Node, Node)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Node
0..] ([Node] -> [(Node, Node)]) -> [Node] -> [(Node, Node)]
forall a b. (a -> b) -> a -> b
$ [Node] -> [Node]
forall a. Ord a => [a] -> [a]
sort ([Node] -> [Node]) -> [Node] -> [Node]
forall a b. (a -> b) -> a -> b
$ (LNode CFNode -> Node) -> [LNode CFNode] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map LNode CFNode -> Node
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 ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
 [(Id, Node)])
forall {a}.
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))], [a])
after ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
 [(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
-> Bool
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 ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
 [(Id, Node)])
forall {a}.
([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))], [a])
before

-- Renumber the graph in topological order
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 = [(Node, Node)] -> Map Node Node
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (([Node] -> [Node] -> [(Node, Node)])
-> [Node] -> [Node] -> [(Node, Node)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Node] -> [Node] -> [(Node, Node)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Node
0..] ([Node] -> [(Node, Node)]) -> [Node] -> [(Node, Node)]
forall a b. (a -> b) -> a -> b
$ CFGraph -> [Node]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [Node]
topsort ([LNode CFNode] -> [LEdge CFEdge] -> CFGraph
forall a b. [LNode a] -> [LEdge b] -> Gr a b
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 ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
 [(Id, Node)])
-> ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
-> Bool
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

-- Collapse structural nodes that just form long chains like x->x->x.
-- This way we can generate them with abandon, without making DFA slower.
--
-- Note in particular that we can't remove a structural node x in
-- foo -> x -> bar , because then the pre/post-condition for tokens
-- previously pointing to x would be wrong.
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
        (
            (LNode CFNode -> Bool) -> [LNode CFNode] -> [LNode CFNode]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Node
n, CFNode
_) -> Node
n Node -> Map Node Node -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Map Node Node
recursiveRemapping) [LNode CFNode]
nodes,
            (LEdge CFEdge -> Bool) -> [LEdge CFEdge] -> [LEdge CFEdge]
forall a. (a -> Bool) -> [a] -> [a]
filter (LEdge CFEdge -> Set (LEdge CFEdge) -> Bool
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 = (LEdge CFEdge -> Bool) -> [LEdge CFEdge] -> [LEdge CFEdge]
forall a. (a -> Bool) -> [a] -> [a]
filter LEdge CFEdge -> Bool
forall {a} {b}. (a, b, CFEdge) -> Bool
isRegularEdge [LEdge CFEdge]
edges
    inDegree :: Map Node Integer
inDegree = [Node] -> Map Node Integer
counter ([Node] -> Map Node Integer) -> [Node] -> Map Node Integer
forall a b. (a -> b) -> a -> b
$ (LEdge CFEdge -> Node) -> [LEdge CFEdge] -> [Node]
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 ([Node] -> Map Node Integer) -> [Node] -> Map Node Integer
forall a b. (a -> b) -> a -> b
$ (LEdge CFEdge -> Node) -> [LEdge CFEdge] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (\(Node
from,Node
to,CFEdge
_) -> Node
to) [LEdge CFEdge]
regularEdges
    structuralNodes :: Set Node
structuralNodes = [Node] -> Set Node
forall a. Ord a => [a] -> Set a
S.fromList ([Node] -> Set Node) -> [Node] -> Set Node
forall a b. (a -> b) -> a -> b
$ (LNode CFNode -> Node) -> [LNode CFNode] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map LNode CFNode -> Node
forall a b. (a, b) -> a
fst ([LNode CFNode] -> [Node]) -> [LNode CFNode] -> [Node]
forall a b. (a -> b) -> a -> b
$ (LNode CFNode -> Bool) -> [LNode CFNode] -> [LNode CFNode]
forall a. (a -> Bool) -> [a] -> [a]
filter LNode CFNode -> Bool
forall {a}. (a, CFNode) -> Bool
isStructural [LNode CFNode]
nodes
    candidateNodes :: Set Node
candidateNodes = (Node -> Bool) -> Set Node -> Set Node
forall a. (a -> Bool) -> Set a -> Set a
S.filter Node -> Bool
isLinear Set Node
structuralNodes
    edgesToCollapse :: Set (LEdge CFEdge)
edgesToCollapse = [LEdge CFEdge] -> Set (LEdge CFEdge)
forall a. Ord a => [a] -> Set a
S.fromList ([LEdge CFEdge] -> Set (LEdge CFEdge))
-> [LEdge CFEdge] -> Set (LEdge CFEdge)
forall a b. (a -> b) -> a -> b
$ (LEdge CFEdge -> Bool) -> [LEdge CFEdge] -> [LEdge CFEdge]
forall a. (a -> Bool) -> [a] -> [a]
filter LEdge CFEdge -> Bool
forall {c}. (Node, Node, c) -> Bool
filterEdges [LEdge CFEdge]
regularEdges

    remapping :: M.Map Node Node
    remapping :: Map Node Node
remapping = (Map Node Node -> (Node, Node) -> Map Node Node)
-> Map Node Node -> [(Node, Node)] -> Map Node Node
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Node Node
m (Node
new, Node
old) -> Node -> Node -> Map Node Node -> Map Node Node
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Node
old Node
new Map Node Node
m) Map Node Node
forall k a. Map k a
M.empty ([(Node, Node)] -> Map Node Node)
-> [(Node, Node)] -> Map Node Node
forall a b. (a -> b) -> a -> b
$ (LEdge CFEdge -> (Node, Node)) -> [LEdge CFEdge] -> [(Node, Node)]
forall a b. (a -> b) -> [a] -> [b]
map LEdge CFEdge -> (Node, Node)
forall {b} {c}. Ord b => (b, b, c) -> (b, b)
orderEdge ([LEdge CFEdge] -> [(Node, Node)])
-> [LEdge CFEdge] -> [(Node, Node)]
forall a b. (a -> b) -> a -> b
$ Set (LEdge CFEdge) -> [LEdge CFEdge]
forall a. Set a -> [a]
S.toList Set (LEdge CFEdge)
edgesToCollapse
    recursiveRemapping :: Map Node Node
recursiveRemapping = [(Node, Node)] -> Map Node Node
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Node, Node)] -> Map Node Node)
-> [(Node, Node)] -> Map Node Node
forall a b. (a -> b) -> a -> b
$ (Node -> (Node, Node)) -> [Node] -> [(Node, Node)]
forall a b. (a -> b) -> [a] -> [b]
map (\Node
c -> (Node
c, Map Node Node -> Node -> Node
recursiveLookup Map Node Node
remapping Node
c)) ([Node] -> [(Node, Node)]) -> [Node] -> [(Node, Node)]
forall a b. (a -> b) -> a -> b
$ Map Node Node -> [Node]
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 Node -> Set Node -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Node
candidateNodes Bool -> Bool -> Bool
&& Node
b Node -> Set Node -> Bool
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 b -> b -> Bool
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 = (Map Node Integer -> Node -> Map Node Integer)
-> Map Node Integer -> [Node] -> Map Node Integer
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Node Integer
map Node
key -> (Integer -> Integer -> Integer)
-> Node -> Integer -> Map Node Integer -> Map Node Integer
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+) Node
key Integer
1 Map Node Integer
map) Map Node Integer
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 Node -> Map Node Node -> Maybe Node
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 =
        Integer -> Node -> Map Node Integer -> Integer
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Integer
0 Node
node Map Node Integer
inDegree Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
        Bool -> Bool -> Bool
&& Integer -> Node -> Map Node Integer -> Integer
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Integer
0 Node
node Map Node Integer
outDegree Integer -> Integer -> Bool
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) =
    (Map Node Node -> Node -> Node
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 ((IdTagged CFEffect -> IdTagged CFEffect)
-> [IdTagged CFEffect] -> [IdTagged CFEffect]
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 (Map Node Node -> Node -> Node
forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
m Node
a) (Map Node Node -> Node -> Node
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 -> Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> Id -> Node -> Node -> CFEffect
CFDefineFunction String
name Id
id (Map Node Node -> Node -> Node
forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
map Node
start) (Map Node Node -> Node -> Node
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) = (Map Node Node -> Node -> Node
forall {k}. Ord k => Map k k -> k -> k
remapHelper Map Node Node
map Node
from, Map Node Node -> Node -> Node
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 = k -> k -> Map k k -> k
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
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq, Node -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Node -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> Range -> ShowS
showsPrec :: Node -> Range -> ShowS
$cshow :: Range -> String
show :: Range -> String
$cshowList :: [Range] -> ShowS
showList :: [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 = Maybe Node
forall a. Maybe a
Nothing,
    cfReturnTarget :: Maybe Node
cfReturnTarget = Maybe Node
forall a. Maybe a
Nothing,
    cfParameters :: CFGParameters
cfParameters = CFGParameters
params
}

-- The monad we generate a graph in
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 <- CFM Node
forall s (m :: * -> *). MonadState s m => m s
get
    [Id]
stack <- (CFContext -> [Id])
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Id]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CFContext -> [Id]
cfTokenStack
    Node
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Node
nNode -> Node -> Node
forall a. Num a => a -> a -> a
+Node
1)
    ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
 [(Id, Node)])
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([(Node
n, CFNode
label)], [], [], (Id -> (Id, Node)) -> [Id] -> [(Id, Node)]
forall a b. (a -> b) -> [a] -> [b]
map (\Id
c -> (Id
c, Node
n)) [Id]
stack)
    Node -> CFM Node
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
n

newNodeRange :: CFNode -> CFM Range
-- newNodeRange label = nodeToRange <$> newNode label
newNodeRange :: CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange CFNode
label = Node -> Range
nodeToRange (Node -> Range)
-> CFM Node
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode CFNode
label

-- Build a disjoint piece of the graph and return a CFExecuteSubshell. The Id is used purely for debug naming.
subshell :: Id -> String -> CFM Range -> CFM Range
subshell :: Id
-> String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
subshell Id
id String
reason RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
p = do
    Node
start <- CFNode -> CFM Node
newNode (CFNode -> CFM Node) -> CFNode -> CFM Node
forall a b. (a -> b) -> a -> b
$ String -> CFNode
CFEntryPoint (String -> CFNode) -> String -> CFNode
forall a b. (a -> b) -> a -> b
$ String
"Subshell " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Id -> String
forall a. Show a => a -> String
show Id
id String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
reason
    Node
end <- CFNode -> CFM Node
newNode CFNode
CFStructuralNode
    Range
middle <- (CFContext -> CFContext)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
(CFContext -> CFContext)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfExitTarget = Just end, cfReturnTarget = Just end}) RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
p
    [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Node -> Range
nodeToRange Node
start, Range
middle, Node -> Range
nodeToRange Node
end]
    CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ String -> Node -> Node -> CFNode
CFExecuteSubshell String
reason Node
start Node
end


withFunctionScope :: RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
withFunctionScope RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
p = do
    Node
end <- CFNode -> CFM Node
newNode CFNode
CFStructuralNode
    Range
body <- (CFContext -> CFContext)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
(CFContext -> CFContext)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfReturnTarget = Just end, cfIsFunction = True }) RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
p
    [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
body, Node -> Range
nodeToRange Node
end]

-- Anything that happens recursively in f will be attributed to this id
under :: Id -> CFM a -> CFM a
under :: forall a. Id -> CFM a -> CFM a
under Id
id CFM a
f = (CFContext -> CFContext) -> CFM a -> CFM a
forall a.
(CFContext -> CFContext)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfTokenStack = id:(cfTokenStack 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
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
link Node
from Node
to CFEdge
label = do
    ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
 [(Id, Node)])
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([], [(Node
from, Node
to, CFEdge
label)], [], [])

registerNode :: Id -> Range -> CFM ()
registerNode :: Id
-> Range
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
registerNode Id
id (Range Node
start Node
end) = ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
 [(Id, Node)])
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([], [], [(Id
id, (Node
start, Node
end))], [])

linkRange :: Range -> Range -> CFM Range
linkRange :: Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange = CFEdge
-> Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRangeAs CFEdge
CFEFlow

linkRangeAs :: CFEdge -> Range -> Range -> CFM Range
linkRangeAs :: CFEdge
-> Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRangeAs CFEdge
label (Range Node
start Node
mid1) (Range Node
mid2 Node
end) = do
    Node
-> Node
-> CFEdge
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
link Node
mid1 Node
mid2 CFEdge
label
    Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> Node -> Range
Range Node
start Node
end)

-- Like linkRange but without actually linking
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]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [] = String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a. HasCallStack => String -> a
error String
"Empty range"
linkRanges (Range
first:[Range]
rest) = (Range
 -> Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
first [Range]
rest

sequentially :: [Token] -> CFM Range
sequentially :: [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list = do
    Range
first <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
    [Range]
rest <- (Token
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Token]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build [Token]
list
    [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges (Range
firstRange -> [Range] -> [Range]
forall a. a -> [a] -> [a]
:[Range]
rest)

withContext :: (CFContext -> CFContext) -> CFM a -> CFM a
withContext :: forall a.
(CFContext -> CFContext)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
withContext = (CFContext -> CFContext)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall a.
(CFContext -> CFContext)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
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 :: RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
asCondition = (CFContext -> CFContext)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
(CFContext -> CFContext)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
withContext (\CFContext
c -> CFContext
c { cfIsCondition = True })

newStructuralNode :: RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode = CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange CFNode
CFStructuralNode

buildRoot :: Token -> CFM Range
buildRoot :: Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
buildRoot Token
t = Id
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a. Id -> CFM a -> CFM a
under (Token -> Id
getId Token
t) (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ do
    Range
entry <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
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 <- (CFContext -> CFContext)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
(CFContext -> CFContext)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfExitTarget = Just end, cfReturnTarget = Just impliedExit}) (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t
    Range
range <- [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
entry, Range
start, Node -> Range
nodeToRange Node
impliedExit, Node -> Range
nodeToRange Node
end]
    Id
-> Range
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
registerNode (Token -> Id
getId Token
t) Range
range
    Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
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 the CFG.
build :: Token -> CFM Range
build :: Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t = do
    Range
range <- Id
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a. Id -> CFM a -> CFM a
under (Token -> Id
getId Token
t) (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build' Token
t
    Id
-> Range
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
registerNode (Token -> Id
getId Token
t) Range
range
    Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Range
range
  where
    build' :: Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build' Token
t = case Token
t of
        T_Annotation Id
_ [Annotation]
_ Token
list -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
list
        T_Script Id
_ Token
_ [Token]
list -> do
            [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list

        TA_Assignment Id
id String
op var :: Token
var@(TA_Variable Id
_ String
name [Token]
indices) Token
rhs -> do
            -- value first: (( var[x=1] = (x=2) )) runs x=1 last
            Range
value <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
rhs
            Range
subscript <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
indices
            Range
read <-
                if String
op String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"="
                then RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
                -- This is += or something
                else CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
name

            Range
write <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name (CFValue -> CFEffect) -> CFValue -> CFEffect
forall a b. (a -> b) -> a -> b
$
                        if [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
indices
                        then CFValue
CFValueInteger
                        else CFValue
CFValueArray

            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
value, Range
subscript, Range
read, Range
write]

        TA_Assignment Id
id String
op Token
lhs Token
rhs -> do
            -- This is likely an invalid assignment like (( 1 = 2 )), but it
            -- could be e.g. x=y; (( $x = 3 )); echo $y, so expand both sides
            -- without updating anything
            [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token
lhs, Token
rhs]

        TA_Binary Id
_ String
_ Token
a Token
b -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token
a,Token
b]
        TA_Expansion Id
_ [Token]
list -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list
        TA_Sequence Id
_ [Token]
list -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list
        TA_Parentesis Id
_ Token
t -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t

        TA_Trinary Id
_ Token
cond Token
a Token
b -> do
            Range
condition <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
cond
            Range
ifthen <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
a
            Range
elsethen <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
b
            Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
condition, Range
ifthen, Range
end]
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
condition, Range
elsethen, Range
end]

        TA_Variable Id
id String
name [Token]
indices -> do
            Range
subscript <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
indices
            Range
hint <-
                if [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
indices
                then RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
                else Node -> Range
nodeToRange (Node -> Range)
-> CFM Node
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode (IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFHintArray String
name)
            Range
read <- Node -> Range
nodeToRange (Node -> Range)
-> CFM Node
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode (IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
name)
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
subscript, Range
hint, Range
read]

        TA_Unary Id
id String
op (TA_Variable Id
_ String
name [Token]
indices) | String
"--" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
op Bool -> Bool -> Bool
|| String
"++" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
op -> do
            Range
subscript <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
indices
            Range
read <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
name
            Range
write <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name (CFValue -> CFEffect) -> CFValue -> CFEffect
forall a b. (a -> b) -> a -> b
$
                        if [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
indices
                        then CFValue
CFValueInteger
                        else CFValue
CFValueArray
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
subscript, Range
read, Range
write]
        TA_Unary Id
_ String
_ Token
arg -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
arg

        TC_And Id
_ ConditionType
SingleBracket String
_ Token
lhs Token
rhs -> do
            [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token
lhs, Token
rhs]

        TC_And Id
_ ConditionType
DoubleBracket String
_ Token
lhs Token
rhs -> do
            Range
left <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
lhs
            Range
right <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
rhs
            Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            -- complete
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
left, Range
right, Range
end]
            -- short circuit
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
left Range
end

        -- TODO: Handle integer ops
        TC_Binary Id
_ ConditionType
mode String
str Token
lhs Token
rhs -> do
            Range
left <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
lhs
            Range
right <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
rhs
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
left Range
right

        TC_Empty {} -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode

        TC_Group Id
_ ConditionType
_ Token
t -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t

        -- TODO: Mark as checked
        TC_Nullary Id
_ ConditionType
_ Token
arg -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
arg

        TC_Or Id
_ ConditionType
SingleBracket String
_ Token
lhs Token
rhs -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token
lhs, Token
rhs]

        TC_Or Id
_ ConditionType
DoubleBracket String
_ Token
lhs Token
rhs -> do
            Range
left <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
lhs
            Range
right <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
rhs
            Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            -- complete
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
left, Range
right, Range
end]
            -- short circuit
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
left Range
end

        -- TODO: Handle -v, -z, -n
        TC_Unary Id
_ ConditionType
_ String
op Token
arg -> do
            Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
arg

        T_Arithmetic Id
id Token
root -> do
            Range
exe <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
root
            Range
status <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
exe Range
status

        T_AndIf Id
_ Token
lhs Token
rhs -> do
            Range
left <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
lhs
            Range
right <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
rhs
            Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
left Range
right
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
right Range
end
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
left Range
end

        T_Array Id
_ [Token]
list -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list

        T_Assignment {} -> Maybe Scope
-> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
buildAssignment Maybe Scope
forall a. Maybe a
Nothing Token
t

        T_Backgrounded Id
id Token
body -> do
            Range
start <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            Range
fork <- Id
-> String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
subshell Id
id String
"backgrounding '&'" (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
body
            Range
pid <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetBackgroundPid Id
id
            Range
status <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id

            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
start Range
fork
            -- Add a join from the fork to warn about variable changes
            CFEdge
-> Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRangeAs CFEdge
CFEFalseFlow Range
fork Range
pid
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
start, Range
pid, Range
status]

        T_Backticked Id
id [Token]
body ->
            Id
-> String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
subshell Id
id String
"`..` expansion" (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
body

        T_Banged Id
id Token
cmd -> do
            Range
main <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
cmd
            Range
status <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
main Range
status

        T_BatsTest Id
id String
_ Token
body -> do
            -- These are technically set by the 'run' command, but we'll just define them
            -- up front to avoid figuring out which commands named "run" belong to Bats.
            Range
status <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
"status" CFValue
CFValueInteger
            Range
output <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
"output" CFValue
CFValueString
            Range
main <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
body
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
status, Range
output, Range
main]

        T_BraceExpansion Id
_ [Token]
list -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list

        T_BraceGroup Id
id [Token]
body ->
            [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
body

        T_CaseExpression Id
id Token
t [] -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t

        T_CaseExpression Id
id Token
t list :: [(CaseType, [Token], [Token])]
list@((CaseType, [Token], [Token])
hd:[(CaseType, [Token], [Token])]
tl) -> do
            Range
start <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            Range
token <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t
            NonEmpty (CaseType, Range, Range)
branches <- ((CaseType, [Token], [Token])
 -> RWST
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Identity
      (CaseType, Range, Range))
-> NonEmpty (CaseType, [Token], [Token])
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     (NonEmpty (CaseType, Range, Range))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
mapM (CaseType, [Token], [Token])
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     (CaseType, Range, Range)
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])
hd (CaseType, [Token], [Token])
-> [(CaseType, [Token], [Token])]
-> NonEmpty (CaseType, [Token], [Token])
forall a. a -> [a] -> NonEmpty a
NE.:| [(CaseType, [Token], [Token])]
tl)
            Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode

            let neighbors :: [((CaseType, Range, Range), (CaseType, Range, Range))]
neighbors = [(CaseType, Range, Range)]
-> [(CaseType, Range, Range)]
-> [((CaseType, Range, Range), (CaseType, Range, Range))]
forall a b. [a] -> [b] -> [(a, b)]
zip (NonEmpty (CaseType, Range, Range) -> [(CaseType, Range, Range)]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (CaseType, Range, Range)
branches) ([(CaseType, Range, Range)]
 -> [((CaseType, Range, Range), (CaseType, Range, Range))])
-> [(CaseType, Range, Range)]
-> [((CaseType, Range, Range), (CaseType, Range, Range))]
forall a b. (a -> b) -> a -> b
$ NonEmpty (CaseType, Range, Range) -> [(CaseType, Range, Range)]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty (CaseType, Range, Range)
branches
            let (CaseType
_, Range
firstCond, Range
_) = NonEmpty (CaseType, Range, Range) -> (CaseType, Range, Range)
forall a. NonEmpty a -> a
NE.head NonEmpty (CaseType, Range, Range)
branches
            let (CaseType
_, Range
lastCond, Range
lastBody) = NonEmpty (CaseType, Range, Range) -> (CaseType, Range, Range)
forall a. NonEmpty a -> a
NE.last NonEmpty (CaseType, Range, Range)
branches

            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
start Range
token
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
token Range
firstCond
            (((CaseType, Range, Range), (CaseType, Range, Range))
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [((CaseType, Range, Range), (CaseType, Range, Range))]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((CaseType, Range, Range)
 -> (CaseType, Range, Range)
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> ((CaseType, Range, Range), (CaseType, Range, Range))
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (((CaseType, Range, Range)
  -> (CaseType, Range, Range)
  -> RWS
       CFContext
       ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
        [(Id, Node)])
       Node
       Range)
 -> ((CaseType, Range, Range), (CaseType, Range, Range))
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> ((CaseType, Range, Range)
    -> (CaseType, Range, Range)
    -> RWS
         CFContext
         ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
          [(Id, Node)])
         Node
         Range)
-> ((CaseType, Range, Range), (CaseType, Range, Range))
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Range
-> (CaseType, Range, Range)
-> (CaseType, Range, Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall {a}.
Range
-> (CaseType, Range, Range)
-> (a, Range, Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkBranch Range
end) [((CaseType, Range, Range), (CaseType, Range, Range))]
neighbors
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
lastBody Range
end

            Bool
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (((CaseType, [Token], [Token]) -> Bool)
-> [(CaseType, [Token], [Token])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (CaseType, [Token], [Token]) -> Bool
forall {t :: * -> *} {a} {c}. Foldable t => (a, t Token, c) -> Bool
hasCatchAll [(CaseType, [Token], [Token])]
list) (RWST
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Identity
   ()
 -> RWST
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Identity
      ())
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall a b. (a -> b) -> a -> b
$
                -- There's no *) branch, so assume we can fall through
                RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWST
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Identity
      ())
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall a b. (a -> b) -> a -> b
$ Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
token Range
end

            Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
start Range
end

          where
            -- for a | b | c, evaluate each in turn and allow short circuiting
            buildCond :: [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
buildCond [Token]
list = do
                Range
start <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
                [Range]
conds <- (Token
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Token]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build [Token]
list
                Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
                [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges (Range
startRange -> [Range] -> [Range]
forall a. a -> [a] -> [a]
:[Range]
conds)
                (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Range]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
`linkRange` Range
end) [Range]
conds
                Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
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]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
buildCond [Token]
cond
                Range
b <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
body
                Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
c Range
b
                (a, Range, Range)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     (a, Range, Range)
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
typ, Range
c, Range
b)

            linkBranch :: Range
-> (CaseType, Range, Range)
-> (a, Range, Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkBranch Range
end (CaseType
typ, Range
cond, Range
body) (a
_, Range
nextCond, Range
nextBody) = do
                -- Failure case
                Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
cond Range
nextCond
                -- After body
                case CaseType
typ of
                    CaseType
CaseBreak -> Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
body Range
end
                    CaseType
CaseFallThrough -> Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
body Range
nextBody
                    CaseType
CaseContinue -> Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
body Range
nextCond

            -- Find a *) if any

            hasCatchAll :: (a, t Token, c) -> Bool
hasCatchAll (a
_,t Token
cond,c
_) = (Token -> Bool) -> t Token -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
isCatchAll t Token
cond
            isCatchAll :: Token -> Bool
isCatchAll Token
c = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
                [PseudoGlob]
pg <- Token -> Maybe [PseudoGlob]
wordToExactPseudoGlob Token
c
                Bool -> Maybe Bool
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
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
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
op
            Range
status <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
cond Range
status

        T_CoProc Id
id Maybe String
maybeName Token
t -> do
            let name :: String
name = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"COPROC" Maybe String
maybeName
            Range
start <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            Range
parent <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueArray
            Range
child <- Id
-> String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
subshell Id
id String
"coproc" (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t
            Range
end <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id

            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
start Range
parent
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
start Range
child
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
parent Range
end
            CFEdge
-> Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRangeAs CFEdge
CFEFalseFlow Range
child Range
end

            Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
start Range
end
        T_CoProcBody Id
_ Token
t -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t

        T_DollarArithmetic Id
_ Token
arith -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
arith
        T_DollarDoubleQuoted Id
_ [Token]
list -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list
        T_DollarSingleQuoted Id
_ String
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
        T_DollarBracket Id
_ Token
t -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t

        T_DollarBraced Id
id Bool
_ Token
t -> do
            let str :: String
str = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
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
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t
            [Range]
others <- (String
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [String]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\String
x -> Node -> Range
nodeToRange (Node -> Range)
-> CFM Node
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode (IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
x)) ([String]
indices [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
offsets)
            Range
deps <- [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges (Range
valsRange -> [Range] -> [Range]
forall a. a -> [a] -> [a]
:[Range]
others)
            Range
read <- Node -> Range
nodeToRange (Node -> Range)
-> CFM Node
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CFNode -> CFM Node
newNode (IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
reference)
            Range
totalRead <- Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
deps Range
read

            if (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
modifier) [String
"=", String
":="]
              then do
                Range
optionalAssign <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
reference CFValue
CFValueString)
                Range
result <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
                Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
optionalAssign Range
result
                Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
totalRead Range
result
              else Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Range
totalRead

        T_DoubleQuoted Id
_ [Token]
list -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list

        T_DollarExpansion Id
id [Token]
body ->
            Id
-> String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
subshell Id
id String
"$(..) expansion" (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
body

        T_Extglob Id
_ String
_ [Token]
list -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list

        T_FdRedirect Id
id (Char
'{':String
identifier) Token
op -> do
            let name :: String
name = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') String
identifier
            Range
expression <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
op
            Range
rw <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$
                if Token -> Bool
isClosingFileOp Token
op
                then IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
name
                else IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueInteger

            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
expression Range
rw


        T_FdRedirect Id
_ String
name Token
t -> do
            Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t

        T_ForArithmetic Id
_ Token
initT Token
condT Token
incT [Token]
bodyT -> do
            Range
init <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
initT
            Range
cond <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
condT
            Range
body <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
bodyT
            Range
inc <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
incT
            Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode

            -- Forward edges
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
init, Range
cond, Range
body, Range
inc]
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
cond Range
end
            -- Backward edge
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
inc Range
cond
            Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
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]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forInHelper Id
id String
name [Token]
words [Token]
body

        -- For functions we generate an unlinked subgraph, and mention that in its definition node
        T_Function Id
id FunctionKeyword
_ FunctionParentheses
_ String
name Token
body -> do
            Range
range <- (CFContext -> CFContext)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
(CFContext -> CFContext)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CFContext
c -> CFContext
c { cfExitTarget = Nothing }) (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ do
                Range
entry <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ String -> CFNode
CFEntryPoint (String -> CFNode) -> String -> CFNode
forall a b. (a -> b) -> a -> b
$ String
"function " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
                Range
f <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
withFunctionScope (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
body
                Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
entry Range
f
            let (Range Node
entry Node
exit) = Range
range
            Range
definition <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> Id -> Node -> Node -> CFEffect
CFDefineFunction String
name Id
id Node
entry Node
exit)
            Range
exe <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
definition Range
exe

        T_Glob {} -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none

        T_HereString Id
_ Token
t -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t
        T_HereDoc Id
_ Dashed
_ Quoted
_ String
_ [Token]
list -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list

        T_IfExpression Id
id [([Token], [Token])]
ifs [Token]
elses -> do
            Range
start <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  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 <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Range]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
`linkRange` Range
end) [Range]
branches
            Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
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 <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
asCondition (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
conds
                Range
action <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
thens
                Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
start Range
cond
                Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     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
actionRange -> [Range] -> [Range]
forall a. a -> [a] -> [a]
:[Range]
result)
            doBranches Range
start [] [Token]
elses [Range]
result = do
                Range
rest <-
                    if [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
elses
                    then CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
                    else [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
elses
                Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
start Range
rest
                [Range]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Range]
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
restRange -> [Range] -> [Range]
forall a. a -> [a] -> [a]
:[Range]
result)

        T_Include Id
_ Token
t -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t

        T_IndexedElement Id
_ [Token]
indicesT Token
valueT -> do
            Range
indices <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
indicesT
            Range
value <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
valueT
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
indices Range
value

        T_IoDuplicate Id
_ Token
op String
_ -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
op

        T_IoFile Id
_ Token
op Token
t -> do
            Range
exp <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
t
            Range
doesntDoMuch <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
op
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
exp Range
doesntDoMuch

        T_Literal {} -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none

        T_NormalWord Id
_ [Token]
list -> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
list

        T_OrIf Id
_ Token
lhs Token
rhs -> do
            Range
left <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
lhs
            Range
right <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
rhs
            Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
left Range
right
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
right Range
end
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
left Range
end

        T_Pipeline Id
_ [Token]
_ [Token
cmd] -> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
cmd
        T_Pipeline Id
id [Token]
_ [Token]
cmds -> do
            Range
start <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            Bool
hasLastpipe <- (CFContext -> Bool)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     Bool
forall a.
(CFContext -> a)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader ((CFContext -> Bool)
 -> RWST
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Identity
      Bool)
-> (CFContext -> Bool)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     Bool
forall a b. (a -> b) -> a -> b
$ CFGParameters -> Bool
cfLastpipe (CFGParameters -> Bool)
-> (CFContext -> CFGParameters) -> CFContext -> Bool
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
            -- Ideally we'd let this exit code be that of the last command in the pipeline but ok
            Range
end <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id

            (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Range]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
start) [Range]
leading
            (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Range]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Range
c -> CFEdge
-> Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRangeAs CFEdge
CFEFalseFlow Range
c Range
end) [Range]
leading
            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges ([Range]
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [Range
start] [Range] -> [Range] -> [Range]
forall a. [a] -> [a] -> [a]
++ [Range]
last [Range] -> [Range] -> [Range]
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
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
x
                ([Range], [Range])
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ([Range], [Range])
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Range
last])
            buildPipe Bool
lp (Token
first:[Token]
rest) = do
                Range
this <- Id
-> String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
subshell Id
id String
"pipeline" (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     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
                ([Range], [Range])
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ([Range], [Range])
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
thisRange -> [Range] -> [Range]
forall a. a -> [a] -> [a]
:[Range]
leading, [Range]
last)
            buildPipe Bool
_ [] = ([Range], [Range])
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ([Range], [Range])
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])

        T_ProcSub Id
id String
op [Token]
cmds -> do
            Range
start <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            Range
body <- Id
-> String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
subshell Id
id (String
op String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"() process substitution") (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
cmds
            Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode

            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
start Range
body
            CFEdge
-> Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRangeAs CFEdge
CFEFalseFlow Range
body Range
end
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
start Range
end

        T_Redirecting Id
_ [Token]
redirs Token
cmd -> do
            -- For simple commands, this is the other way around in bash
            -- We do it in this order for comound commands like { x=name; } > "$x"
            Range
redir <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
redirs
            Range
body <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
cmd
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
redir Range
body

        T_SelectIn Id
id String
name [Token]
words [Token]
body -> Id
-> String
-> [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forInHelper Id
id String
name [Token]
words [Token]
body

        T_SimpleCommand Id
id [Token]
vars [] -> do
            -- Vars can also be empty, as in the command "> foo"
            Range
assignments <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
vars
            Range
status <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
assignments Range
status

        T_SimpleCommand Id
id [Token]
vars (Token
cmd:[Token]
args) ->
            Token
-> [Token]
-> NonEmpty Token
-> Maybe String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleCommand Token
t [Token]
vars (Token
cmd Token -> [Token] -> NonEmpty Token
forall a. a -> [a] -> NonEmpty a
NE.:| [Token]
args) (Maybe String
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Maybe String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getUnquotedLiteral Token
cmd

        T_SingleQuoted Id
_ String
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none

        T_SourceCommand Id
_ Token
originalCommand Token
inlinedSource -> do
            Range
cmd <- Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
originalCommand
            Range
end <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
            Range
inline <- Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a. Range -> CFM a -> CFM a
withReturn Range
end (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
inlinedSource
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
cmd Range
inline
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
inline Range
end
            Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
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
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
subshell Id
id String
"explicit (..) subshell" (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
body
            Range
status <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
main Range
status

        T_UntilExpression Id
id [Token]
cond [Token]
body -> Id
-> [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
whileHelper Id
id [Token]
cond [Token]
body
        T_WhileExpression Id
id [Token]
cond [Token]
body -> Id
-> [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
whileHelper Id
id [Token]
cond [Token]
body

        T_CLOBBER Id
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
        T_GREATAND Id
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
        T_LESSAND Id
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
        T_LESSGREAT Id
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
        T_DGREAT Id
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
        T_Greater Id
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
        T_Less Id
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
        T_ParamSubSpecialChar Id
_ String
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none

        Token
x -> do
            String
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     Any
forall a. HasCallStack => String -> a
error (String
"Unimplemented: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Token -> String
forall a. Show a => a -> String
show Token
x) -- STRIP
            RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none

--  Still in `where` clause
    forInHelper :: Id
-> String
-> [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forInHelper Id
id String
name [Token]
words [Token]
body = do
        Range
entry <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
        Range
expansion <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
words
        Range
assignmentChoice <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
        [Range]
assignments <-
            if [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
words Bool -> Bool -> Bool
|| (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Token -> Bool
willSplit [Token]
words
            then (Range -> [Range] -> [Range]
forall a. a -> [a] -> [a]
:[]) (Range -> [Range])
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueString)
            else (Token
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Token]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Token
t -> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name (CFValue -> CFEffect) -> CFValue -> CFEffect
forall a b. (a -> b) -> a -> b
$ Id -> [CFStringPart] -> CFValue
CFValueComputed (Token -> Id
getId Token
t) ([CFStringPart] -> CFValue) -> [CFStringPart] -> CFValue
forall a b. (a -> b) -> a -> b
$ Token -> [CFStringPart]
tokenToParts Token
t) [Token]
words
        Range
body <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
body
        Range
exit <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode
        -- Forward edges
        [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
entry, Range
expansion, Range
assignmentChoice]
        (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Range]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Range
t -> [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
assignmentChoice, Range
t, Range
body]) [Range]
assignments
        Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
body Range
exit
        Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
expansion Range
exit
        -- Backward edge
        Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
body Range
assignmentChoice
        Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Range -> Range -> Range
spanRange Range
entry Range
exit

    whileHelper :: Id
-> [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
whileHelper Id
id [Token]
cond [Token]
body = do
        Range
condRange <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
asCondition (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
cond
        Range
bodyRange <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
body
        Range
end <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (Id -> CFNode
CFSetExitCode Id
id)

        Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
condRange Range
bodyRange
        Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
bodyRange Range
condRange
        Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
condRange Range
end


handleCommand :: Token
-> [Token]
-> NonEmpty Token
-> Maybe String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleCommand Token
cmd [Token]
vars NonEmpty Token
args Maybe String
literalCmd = do
    -- TODO: Handle assignments in declaring commands

    case Maybe String
literalCmd of
        Just String
"exit" -> [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansion [Token]
vars (NonEmpty Token -> [Token]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Token
args) (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
handleExit
        Just String
"return" -> [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansion [Token]
vars (NonEmpty Token -> [Token]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Token
args) (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
handleReturn
        Just String
"unset" -> [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleUnset NonEmpty Token
args

        Just String
"declare" -> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleDeclare NonEmpty Token
args
        Just String
"local" -> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleDeclare NonEmpty Token
args
        Just String
"typeset" -> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleDeclare NonEmpty Token
args

        Just String
"printf" -> [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handlePrintf NonEmpty Token
args
        Just String
"wait" -> [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleWait NonEmpty Token
args

        Just String
"mapfile" -> [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleMapfile NonEmpty Token
args
        Just String
"readarray" -> [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleMapfile NonEmpty Token
args

        Just String
"read" -> [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleRead NonEmpty Token
args

        Just String
"DEFINE_boolean" -> [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleDEFINE NonEmpty Token
args
        Just String
"DEFINE_float" ->   [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleDEFINE NonEmpty Token
args
        Just String
"DEFINE_integer" -> [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleDEFINE NonEmpty Token
args
        Just String
"DEFINE_string" ->  [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars NonEmpty Token
args (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleDEFINE NonEmpty Token
args

        -- This will mostly behave like 'command' but ok
        Just String
"builtin" ->
            case NonEmpty Token
args of
                Token
_ NE.:| [] -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
regular
                (Token
_ NE.:| Token
newcmd:[Token]
newargs) ->
                    Token
-> [Token]
-> NonEmpty Token
-> Maybe String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleCommand Token
newcmd [Token]
vars (Token
newcmd Token -> [Token] -> NonEmpty Token
forall a. a -> [a] -> NonEmpty a
NE.:| [Token]
newargs) (Maybe String
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Maybe String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getLiteralString Token
newcmd
        Just String
"command" ->
            case NonEmpty Token
args of
                Token
_ NE.:| [] -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
regular
                (Token
_ NE.:| Token
newcmd:[Token]
newargs) ->
                    Id
-> [Token]
-> NonEmpty Token
-> Maybe String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleOthers (Token -> Id
getId Token
newcmd) [Token]
vars (Token
newcmd Token -> [Token] -> NonEmpty Token
forall a. a -> [a] -> NonEmpty a
NE.:| [Token]
newargs) (Maybe String
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Maybe String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getLiteralString Token
newcmd
        Maybe String
_ -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
regular

  where
    regular :: RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
regular = Id
-> [Token]
-> NonEmpty Token
-> Maybe String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleOthers (Token -> Id
getId Token
cmd) [Token]
vars NonEmpty Token
args Maybe String
literalCmd
    handleExit :: RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
handleExit = do
        Maybe Node
exitNode <- (CFContext -> Maybe Node)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     (Maybe Node)
forall a.
(CFContext -> a)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
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
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
link Node
exit Node
target CFEdge
CFEExit
                Node
unreachable <- CFNode -> CFM Node
newNode CFNode
CFUnreachable
                Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
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
                Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Node -> Node -> Range
Range Node
exit Node
unreachable

    handleReturn :: RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
handleReturn = do
        Maybe Node
returnTarget <- (CFContext -> Maybe Node)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     (Maybe Node)
forall a.
(CFContext -> a)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader CFContext -> Maybe Node
cfReturnTarget
        case Maybe Node
returnTarget of
            Maybe Node
Nothing -> String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a. HasCallStack => String -> a
error (String
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
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
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
link Node
ret Node
target CFEdge
CFEFlow
                Node
unreachable <- CFNode -> CFM Node
newNode CFNode
CFUnreachable
                Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Node -> Node -> Range
Range Node
ret Node
unreachable

    handleUnset :: NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleUnset (Token
cmd NE.:| [Token]
args) = do
        case () of
                ()
_ | String
"n" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flagNames -> (String -> CFEffect)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
unsetWith String -> CFEffect
CFUndefineNameref
                ()
_ | String
"v" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flagNames -> (String -> CFEffect)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
unsetWith String -> CFEffect
CFUndefineVariable
                ()
_ | String
"f" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
flagNames -> (String -> CFEffect)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
unsetWith String -> CFEffect
CFUndefineFunction
                ()
_ -> (String -> CFEffect)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
unsetWith String -> CFEffect
CFUndefine
      where
        pairs :: [(String, Token)] -- [(Flag string, token)] e.g. [("-f", t), ("", myfunc)]
        pairs :: [(String, Token)]
pairs = ((String, (Token, Token)) -> (String, Token))
-> [(String, (Token, Token))] -> [(String, Token)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
str, (Token
flag, Token
val)) -> (String
str, Token
flag)) ([(String, (Token, Token))] -> [(String, Token)])
-> [(String, (Token, Token))] -> [(String, Token)]
forall a b. (a -> b) -> a -> b
$ [(String, (Token, Token))]
-> Maybe [(String, (Token, Token))] -> [(String, (Token, Token))]
forall a. a -> Maybe a -> a
fromMaybe ((Token -> (String, (Token, Token)))
-> [Token] -> [(String, (Token, Token))]
forall a b. (a -> b) -> [a] -> [b]
map (\Token
c -> (String
"", (Token
c,Token
c))) [Token]
args) (Maybe [(String, (Token, Token))] -> [(String, (Token, Token))])
-> Maybe [(String, (Token, Token))] -> [(String, (Token, Token))]
forall a b. (a -> b) -> a -> b
$ String -> [Token] -> Maybe [(String, (Token, Token))]
getGnuOpts String
"vfn" [Token]
args
        ([(String, Token)]
names, [(String, Token)]
flags) = ((String, Token) -> Bool)
-> [(String, Token)] -> ([(String, Token)], [(String, Token)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> ((String, Token) -> String) -> (String, Token) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Token) -> String
forall a b. (a, b) -> a
fst) [(String, Token)]
pairs
        flagNames :: [String]
flagNames = ((String, Token) -> String) -> [(String, Token)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Token) -> String
forall a b. (a, b) -> a
fst [(String, Token)]
flags
        literalNames :: [(Token, String)] -- Literal names to unset, e.g. [(myfuncToken, "myfunc")]
        literalNames :: [(Token, String)]
literalNames = ((String, Token) -> Maybe (Token, String))
-> [(String, Token)] -> [(Token, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(String
_, Token
t) -> (,) Token
t (String -> (Token, String))
-> Maybe String -> Maybe (Token, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> Maybe String
getLiteralString Token
t) [(String, Token)]
names
        -- Apply a constructor like CFUndefineVariable to each literalName, and tag with its id
        unsetWith :: (String -> CFEffect)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
unsetWith String -> CFEffect
c = CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects ([IdTagged CFEffect] -> CFNode) -> [IdTagged CFEffect] -> CFNode
forall a b. (a -> b) -> a -> b
$ ((Token, String) -> IdTagged CFEffect)
-> [(Token, String)] -> [IdTagged CFEffect]
forall a b. (a -> b) -> [a] -> [b]
map (\(Token
token, String
name) -> Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
token) (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
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 :: NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleDeclare (Token
cmd NE.:| [Token]
args) = do
        Bool
isFunc <- (CFContext -> Bool)
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CFContext -> Bool
cfIsFunction
        -- This is a bit of a kludge: we don't have great support for things like
        -- 'declare -i x=$x' so do one round with declare x=$x, followed by declare -i x
        let ([Token]
evaluated, [IdTagged CFEffect]
assignments, [IdTagged CFEffect]
added, [IdTagged CFEffect]
removed) = [([Token], [IdTagged CFEffect], [IdTagged CFEffect],
  [IdTagged CFEffect])]
-> ([Token], [IdTagged CFEffect], [IdTagged CFEffect],
    [IdTagged CFEffect])
forall a. Monoid a => [a] -> a
mconcat ([([Token], [IdTagged CFEffect], [IdTagged CFEffect],
   [IdTagged CFEffect])]
 -> ([Token], [IdTagged CFEffect], [IdTagged CFEffect],
     [IdTagged CFEffect]))
-> [([Token], [IdTagged CFEffect], [IdTagged CFEffect],
     [IdTagged CFEffect])]
-> ([Token], [IdTagged CFEffect], [IdTagged CFEffect],
    [IdTagged CFEffect])
forall a b. (a -> b) -> a -> b
$ (Token
 -> ([Token], [IdTagged CFEffect], [IdTagged CFEffect],
     [IdTagged CFEffect]))
-> [Token]
-> [([Token], [IdTagged CFEffect], [IdTagged CFEffect],
     [IdTagged CFEffect])]
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]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially ([Token]
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [Token]
evaluated
        Range
assignments <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect]
assignments
        Range
addedProps <- if [IdTagged CFEffect] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IdTagged CFEffect]
added then RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode else CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect]
added
        Range
removedProps <- if [IdTagged CFEffect] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IdTagged CFEffect]
removed then RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode else CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect]
removed
        Range
result <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode (Token -> Id
getId Token
cmd)
        [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges [Range
before, Range
assignments, Range
addedProps, Range
removedProps, Range
result]
      where
        opts :: [String]
opts = ((String, (Token, Token)) -> String)
-> [(String, (Token, Token))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Token, Token)) -> String
forall a b. (a, b) -> a
fst ([(String, (Token, Token))] -> [String])
-> [(String, (Token, Token))] -> [String]
forall a b. (a -> b) -> a -> b
$ [Token] -> [(String, (Token, Token))]
getGenericOpts [Token]
args
        array :: Bool
array = String
"a" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts Bool -> Bool -> Bool
|| Bool
associative
        associative :: Bool
associative = String
"A" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts
        integer :: Bool
integer = String
"i" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts
        func :: Bool
func = String
"f" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts Bool -> Bool -> Bool
|| String
"F" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts
        global :: Bool
global = String
"g" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
opts
        export :: Bool
export = String
"x" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 -> Maybe Scope
scope Bool
isFunc =
            case () of
                ()
_ | Bool
global -> Scope -> Maybe Scope
forall a. a -> Maybe a
Just Scope
GlobalScope
                ()
_ | Bool
isFunc -> Scope -> Maybe Scope
forall a. a -> Maybe a
Just Scope
LocalScope
                ()
_ -> Maybe Scope
forall a. Maybe a
Nothing

        addedProps :: Set CFVariableProp
addedProps = [CFVariableProp] -> Set CFVariableProp
forall a. Ord a => [a] -> Set a
S.fromList ([CFVariableProp] -> Set CFVariableProp)
-> [CFVariableProp] -> Set CFVariableProp
forall a b. (a -> b) -> a -> b
$ [[CFVariableProp]] -> [CFVariableProp]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CFVariableProp]] -> [CFVariableProp])
-> [[CFVariableProp]] -> [CFVariableProp]
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 = [CFVariableProp] -> Set CFVariableProp
forall a. Ord a => [a] -> Set a
S.fromList ([CFVariableProp] -> Set CFVariableProp)
-> [CFVariableProp] -> Set CFVariableProp
forall a b. (a -> b) -> a -> b
$ [[CFVariableProp]] -> [CFVariableProp]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CFVariableProp]] -> [CFVariableProp])
-> [[CFVariableProp]] -> [CFVariableProp]
forall a b. (a -> b) -> a -> b
$ [
            -- Array property can't be unset
            [ CFVariableProp
CFVPInteger | Char
'i' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
unsetOptions ],
            [ CFVariableProp
CFVPExport | Char
'e' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
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 [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token
t]
                val :: [IdTagged CFEffect]
val = [ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ (Bool -> String -> CFValue -> CFEffect
writer Bool
isFunc) String
var (CFValue -> CFEffect) -> CFValue -> CFEffect
forall a b. (a -> b) -> a -> b
$ Id -> [CFStringPart] -> CFValue
CFValueComputed (Token -> Id
getId Token
t) ([CFStringPart] -> CFValue) -> [CFStringPart] -> CFValue
forall a b. (a -> b) -> a -> b
$ [ String -> CFStringPart
CFStringVariable String
var | AssignmentMode
mode AssignmentMode -> AssignmentMode -> Bool
forall a. Eq a => a -> a -> Bool
== AssignmentMode
Append ] [CFStringPart] -> [CFStringPart] -> [CFStringPart]
forall a. [a] -> [a] -> [a]
++ Token -> [CFStringPart]
tokenToParts Token
t ]
                added :: [IdTagged CFEffect]
added = [ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ Maybe Scope -> String -> Set CFVariableProp -> CFEffect
CFSetProps (Bool -> Maybe Scope
scope Bool
isFunc) String
var Set CFVariableProp
addedProps | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> Bool
forall a. Set a -> Bool
S.null Set CFVariableProp
addedProps ]
                removed :: [IdTagged CFEffect]
removed = [ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ Maybe Scope -> String -> Set CFVariableProp -> CFEffect
CFUnsetProps (Bool -> Maybe Scope
scope Bool
isFunc) String
var Set CFVariableProp
addedProps | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set CFVariableProp -> Bool
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 = String -> Token -> String
getLiteralStringDef String
"\0" Token
t
                isKnown :: Bool
isKnown = Char
'\0' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
literal
                match :: Maybe String
match = ([String] -> String) -> Maybe [String] -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall a. HasCallStack => [a] -> a
head (Maybe [String] -> Maybe String) -> Maybe [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ Regex
variableAssignRegex Regex -> String -> Maybe [String]
`matchRegex` String
literal
                name :: String
name = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
literal Maybe String
match

                asLiteral :: IdTagged CFEffect
asLiteral =
                    Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ (Bool -> String -> CFValue -> CFEffect
writer Bool
isFunc) String
name (CFValue -> CFEffect) -> CFValue -> CFEffect
forall a b. (a -> b) -> a -> b
$
                        Id -> [CFStringPart] -> CFValue
CFValueComputed (Token -> Id
getId Token
t) [ String -> CFStringPart
CFStringLiteral (String -> CFStringPart) -> String -> CFStringPart
forall a b. (a -> b) -> a -> b
$ Node -> ShowS
forall a. Node -> [a] -> [a]
drop Node
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
literal ]
                asUnknown :: IdTagged CFEffect
asUnknown =
                    Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ (Bool -> String -> CFValue -> CFEffect
writer Bool
isFunc) String
name (CFValue -> CFEffect) -> CFValue -> CFEffect
forall a b. (a -> b) -> a -> b
$
                        CFValue
CFValueString

                added :: [IdTagged CFEffect]
added = [ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ Maybe Scope -> String -> Set CFVariableProp -> CFEffect
CFSetProps (Bool -> Maybe Scope
scope Bool
isFunc) String
name Set CFVariableProp
addedProps ]
                removed :: [IdTagged CFEffect]
removed = [ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ Maybe Scope -> String -> Set CFVariableProp -> CFEffect
CFUnsetProps (Bool -> Maybe Scope
scope Bool
isFunc) String
name Set CFVariableProp
removedProps ]

            in
                case () of
                    ()
_ | Bool -> Bool
not (String -> Bool
isVariableName String
name) -> ([Token]
pre, [], [], [])
                    ()
_ | Maybe String -> Bool
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)
                    ()
_ | Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
match -> ([Token]
pre, [IdTagged CFEffect
asUnknown], [IdTagged CFEffect]
added, [IdTagged CFEffect]
removed)
                    -- e.g. declare -i x
                    ()
_ -> ([Token]
pre, [], [IdTagged CFEffect]
added, [IdTagged CFEffect]
removed)

        -- find "ia" from `define +i +a`
        unsetOptions :: String
        unsetOptions :: String
unsetOptions =
            let
                strings :: [String]
strings = (Token -> Maybe String) -> [Token] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Token -> Maybe String
getLiteralString [Token]
args
                plusses :: [String]
plusses = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"+" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
strings
            in
                ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Node -> ShowS
forall a. Node -> [a] -> [a]
drop Node
1) [String]
plusses

    handlePrintf :: NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handlePrintf (Token
cmd NE.:| [Token]
args) =
        CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects ([IdTagged CFEffect] -> CFNode) -> [IdTagged CFEffect] -> CFNode
forall a b. (a -> b) -> a -> b
$ Maybe (IdTagged CFEffect) -> [IdTagged CFEffect]
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) <- String -> [(String, (Token, Token))] -> Maybe (Token, Token)
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
            IdTagged CFEffect -> Maybe (IdTagged CFEffect)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (IdTagged CFEffect -> Maybe (IdTagged CFEffect))
-> IdTagged CFEffect -> Maybe (IdTagged CFEffect)
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
arg) (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueString

    handleWait :: NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleWait (Token
cmd NE.:| [Token]
args) =
        CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects ([IdTagged CFEffect] -> CFNode) -> [IdTagged CFEffect] -> CFNode
forall a b. (a -> b) -> a -> b
$ Maybe (IdTagged CFEffect) -> [IdTagged CFEffect]
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) <- String -> [(String, (Token, Token))] -> Maybe (Token, Token)
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
            IdTagged CFEffect -> Maybe (IdTagged CFEffect)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (IdTagged CFEffect -> Maybe (IdTagged CFEffect))
-> IdTagged CFEffect -> Maybe (IdTagged CFEffect)
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
arg) (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueInteger

    handleMapfile :: NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleMapfile (Token
cmd NE.:| [Token]
args) =
        CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect
findVar]
      where
        findVar :: IdTagged CFEffect
findVar =
            let (Id
id, String
name) = (Id, String) -> Maybe (Id, String) -> (Id, String)
forall a. a -> Maybe a -> a
fromMaybe (Token -> Id
getId Token
cmd, String
"MAPFILE") (Maybe (Id, String) -> (Id, String))
-> Maybe (Id, String) -> (Id, String)
forall a b. (a -> b) -> a -> b
$ Maybe (Id, String)
getFromArg Maybe (Id, String) -> Maybe (Id, String) -> Maybe (Id, String)
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (Id, String)
getFromFallback
            in Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
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) <- String -> [(String, (Token, Token))] -> Maybe (Token, Token)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"" [(String, (Token, Token))]
flags
            String
name <- Token -> Maybe String
getLiteralString Token
arg
            (Id, String) -> Maybe (Id, String)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Id
getId Token
arg, String
name)

        getFromFallback :: Maybe (Id, String)
getFromFallback =
            [(Id, String)] -> Maybe (Id, String)
forall a. [a] -> Maybe a
listToMaybe ([(Id, String)] -> Maybe (Id, String))
-> [(Id, String)] -> Maybe (Id, String)
forall a b. (a -> b) -> a -> b
$ (Token -> Maybe (Id, String)) -> [Token] -> [(Id, String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Token -> Maybe (Id, String)
getIfVar ([Token] -> [(Id, String)]) -> [Token] -> [(Id, String)]
forall a b. (a -> b) -> a -> b
$ [Token] -> [Token]
forall a. [a] -> [a]
reverse [Token]
args
        getIfVar :: Token -> Maybe (Id, String)
getIfVar Token
c = do
            String
name <- Token -> Maybe String
getLiteralString Token
c
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String -> Bool
isVariableName String
name
            (Id, String) -> Maybe (Id, String)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> Id
getId Token
c, String
name)

    handleRead :: NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleRead (Token
cmd NE.:| [Token]
args) = CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects [IdTagged CFEffect]
main
      where
        main :: [IdTagged CFEffect]
main = [IdTagged CFEffect]
-> Maybe [IdTagged CFEffect] -> [IdTagged CFEffect]
forall a. a -> Maybe a -> a
fromMaybe [IdTagged CFEffect]
fallback (Maybe [IdTagged CFEffect] -> [IdTagged CFEffect])
-> Maybe [IdTagged CFEffect] -> [IdTagged CFEffect]
forall a b. (a -> b) -> a -> b
$ do
            [(String, (Token, Token))]
flags <- String -> [Token] -> Maybe [(String, (Token, Token))]
getGnuOpts String
flagsForRead [Token]
args
            [IdTagged CFEffect] -> Maybe [IdTagged CFEffect]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([IdTagged CFEffect] -> Maybe [IdTagged CFEffect])
-> [IdTagged CFEffect] -> Maybe [IdTagged CFEffect]
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect]
-> Maybe [IdTagged CFEffect] -> [IdTagged CFEffect]
forall a. a -> Maybe a -> a
fromMaybe ([(String, (Token, Token))] -> [IdTagged CFEffect]
withFields [(String, (Token, Token))]
flags) (Maybe [IdTagged CFEffect] -> [IdTagged CFEffect])
-> Maybe [IdTagged CFEffect] -> [IdTagged CFEffect]
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) <- String -> [(String, (Token, Token))] -> Maybe (Token, Token)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"a" [(String, (Token, Token))]
flags
            [IdTagged CFEffect] -> Maybe [IdTagged CFEffect]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([IdTagged CFEffect] -> Maybe [IdTagged CFEffect])
-> [IdTagged CFEffect] -> Maybe [IdTagged CFEffect]
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect]
-> Maybe [IdTagged CFEffect] -> [IdTagged CFEffect]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [IdTagged CFEffect] -> [IdTagged CFEffect])
-> Maybe [IdTagged CFEffect] -> [IdTagged CFEffect]
forall a b. (a -> b) -> a -> b
$ do
                String
name <- Token -> Maybe String
getLiteralString Token
token
                [IdTagged CFEffect] -> Maybe [IdTagged CFEffect]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
token) (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
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 = ((String, (Token, Token)) -> Maybe (IdTagged CFEffect))
-> [(String, (Token, Token))] -> [IdTagged CFEffect]
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
_)) <- (String, (Token, Token)) -> Maybe (String, (Token, Token))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (String, (Token, Token))
f
            String
name <- Token -> Maybe String
getLiteralString Token
t
            IdTagged CFEffect -> Maybe (IdTagged CFEffect)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (IdTagged CFEffect -> Maybe (IdTagged CFEffect))
-> IdTagged CFEffect -> Maybe (IdTagged CFEffect)
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
t) (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
CFValueString

        fallback :: [IdTagged CFEffect]
fallback =
            let
                names :: [(Id, String)]
names = [(Id, String)] -> [(Id, String)]
forall a. [a] -> [a]
reverse ([(Id, String)] -> [(Id, String)])
-> [(Id, String)] -> [(Id, String)]
forall a b. (a -> b) -> a -> b
$ (Maybe (Id, String) -> (Id, String))
-> [Maybe (Id, String)] -> [(Id, String)]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (Id, String) -> (Id, String)
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe (Id, String)] -> [(Id, String)])
-> [Maybe (Id, String)] -> [(Id, String)]
forall a b. (a -> b) -> a -> b
$ (Maybe (Id, String) -> Bool)
-> [Maybe (Id, String)] -> [Maybe (Id, String)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Maybe (Id, String) -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe (Id, String)] -> [Maybe (Id, String)])
-> [Maybe (Id, String)] -> [Maybe (Id, String)]
forall a b. (a -> b) -> a -> b
$ (Token -> Maybe (Id, String)) -> [Token] -> [Maybe (Id, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\Token
c -> (Id, Maybe String) -> Maybe (Id, String)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => (Id, m a) -> m (Id, a)
sequence (Token -> Id
getId Token
c, Token -> Maybe String
getLiteralString Token
c)) ([Token] -> [Maybe (Id, String)])
-> [Token] -> [Maybe (Id, String)]
forall a b. (a -> b) -> a -> b
$ [Token] -> [Token]
forall a. [a] -> [a]
reverse [Token]
args
                namesOrDefault :: [(Id, String)]
namesOrDefault = if [(Id, String)] -> Bool
forall a. [a] -> Bool
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 = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"a") ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ ((String, (Token, Token)) -> String)
-> [(String, (Token, Token))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Token, Token)) -> String
forall a b. (a, b) -> a
fst ([(String, (Token, Token))] -> [String])
-> [(String, (Token, Token))] -> [String]
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
                ((Id, String) -> IdTagged CFEffect)
-> [(Id, String)] -> [IdTagged CFEffect]
forall a b. (a -> b) -> [a] -> [b]
map (\(Id
id, String
name) -> Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
name CFValue
value) [(Id, String)]
namesOrDefault

    handleDEFINE :: NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleDEFINE (Token
cmd NE.:| [Token]
args) =
        CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [IdTagged CFEffect] -> CFNode
CFApplyEffects ([IdTagged CFEffect] -> CFNode) -> [IdTagged CFEffect] -> CFNode
forall a b. (a -> b) -> a -> b
$ Maybe (IdTagged CFEffect) -> [IdTagged CFEffect]
forall a. Maybe a -> [a]
maybeToList Maybe (IdTagged CFEffect)
findVar
      where
        findVar :: Maybe (IdTagged CFEffect)
findVar = do
            Token
name <- [Token] -> Maybe Token
forall a. [a] -> Maybe a
listToMaybe ([Token] -> Maybe Token) -> [Token] -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Node -> [Token] -> [Token]
forall a. Node -> [a] -> [a]
drop Node
1 [Token]
args
            String
str <- Token -> Maybe String
getLiteralString Token
name
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String -> Bool
isVariableName String
str
            IdTagged CFEffect -> Maybe (IdTagged CFEffect)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (IdTagged CFEffect -> Maybe (IdTagged CFEffect))
-> IdTagged CFEffect -> Maybe (IdTagged CFEffect)
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged (Token -> Id
getId Token
name) (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
CFWriteVariable String
str CFValue
CFValueString

    handleOthers :: Id
-> [Token]
-> NonEmpty Token
-> Maybe String
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
handleOthers Id
id [Token]
vars NonEmpty Token
args Maybe String
cmd =
        [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansion [Token]
vars (NonEmpty Token -> [Token]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Token
args) (RWS
   CFContext
   ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
    [(Id, Node)])
   Node
   Range
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ do
            Range
exe <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Maybe String -> CFNode
CFExecuteCommand Maybe String
cmd
            Range
status <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode Id
id
            Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
exe Range
status

    regularExpansion :: [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansion [Token]
vars [Token]
args RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
p = do
            Range
args <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
args
            [Range]
assignments <- (Token
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Token]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe Scope
-> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
buildAssignment (Scope -> Maybe Scope
forall a. a -> Maybe a
Just Scope
PrefixScope)) [Token]
vars
            Range
exe <- RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
p
            [Range]
dropAssignments <-
                if [Token] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
vars
                then
                    [Range]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Range]
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                else do
                    Range
drop <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange CFNode
CFDropPrefixAssignments
                    [Range]
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     [Range]
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
forall (m :: * -> *) a. Monad m => a -> m a
return [Range
drop]

            [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRanges ([Range]
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ [Range
args] [Range] -> [Range] -> [Range]
forall a. [a] -> [a] -> [a]
++ [Range]
assignments [Range] -> [Range] -> [Range]
forall a. [a] -> [a] -> [a]
++ [Range
exe] [Range] -> [Range] -> [Range]
forall a. [a] -> [a] -> [a]
++ [Range]
dropAssignments

    regularExpansionWithStatus :: [Token]
-> NonEmpty Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansionWithStatus [Token]
vars args :: NonEmpty Token
args@(Token
cmd NE.:| [Token]
_) RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
p = do
        Range
initial <- [Token]
-> [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
regularExpansion [Token]
vars (NonEmpty Token -> [Token]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Token
args) RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
p
        Range
status <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ Id -> CFNode
CFSetExitCode (Token -> Id
getId Token
cmd)
        Range
-> Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
linkRange Range
initial Range
status


none :: RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none = RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
newStructuralNode

data Scope = GlobalScope | LocalScope | PrefixScope
  deriving (Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
/= :: Scope -> Scope -> Bool
Eq, Eq Scope
Eq Scope =>
(Scope -> Scope -> Ordering)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Scope)
-> (Scope -> Scope -> Scope)
-> Ord 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
$ccompare :: Scope -> Scope -> Ordering
compare :: Scope -> Scope -> Ordering
$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
>= :: Scope -> Scope -> Bool
$cmax :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
min :: Scope -> Scope -> Scope
Ord, Node -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Node -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Node -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Node -> Scope -> ShowS
showsPrec :: Node -> Scope -> ShowS
$cshow :: Scope -> String
show :: Scope -> String
$cshowList :: [Scope] -> ShowS
showList :: [Scope] -> ShowS
Show, (forall x. Scope -> Rep Scope x)
-> (forall x. Rep Scope x -> Scope) -> Generic Scope
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
$cfrom :: forall x. Scope -> Rep Scope x
from :: forall x. Scope -> Rep Scope x
$cto :: forall x. Rep Scope x -> Scope
to :: forall x. Rep Scope x -> Scope
Generic, Scope -> ()
(Scope -> ()) -> NFData Scope
forall a. (a -> ()) -> NFData a
$crnf :: Scope -> ()
rnf :: Scope -> ()
NFData)

buildAssignment :: Maybe Scope
-> Token
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
buildAssignment Maybe 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
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
build Token
value
                Range
index <- [Token]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
sequentially [Token]
indices
                Range
read <- case AssignmentMode
mode of
                    AssignmentMode
Append -> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFEffect
CFReadVariable String
var)
                    AssignmentMode
Assign -> RWS
  CFContext
  ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
   [(Id, Node)])
  Node
  Range
none
                let valueType :: CFValue
valueType = if [Token] -> Bool
forall a. [a] -> Bool
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 Maybe Scope
scope of
                                    Just Scope
PrefixScope -> String -> CFValue -> CFEffect
CFWritePrefix
                                    Just Scope
LocalScope -> String -> CFValue -> CFEffect
CFWriteLocal
                                    Just Scope
GlobalScope -> String -> CFValue -> CFEffect
CFWriteGlobal
                                    Maybe Scope
Nothing -> String -> CFValue -> CFEffect
CFWriteVariable
                Range
write <- CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
newNodeRange (CFNode
 -> RWS
      CFContext
      ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
       [(Id, Node)])
      Node
      Range)
-> CFNode
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a b. (a -> b) -> a -> b
$ IdTagged CFEffect -> CFNode
applySingle (IdTagged CFEffect -> CFNode) -> IdTagged CFEffect -> CFNode
forall a b. (a -> b) -> a -> b
$ Id -> CFEffect -> IdTagged CFEffect
forall a. Id -> a -> IdTagged a
IdTagged Id
id (CFEffect -> IdTagged CFEffect) -> CFEffect -> IdTagged CFEffect
forall a b. (a -> b) -> a -> b
$ String -> CFValue -> CFEffect
scoper String
var CFValue
valueType
                [Range]
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     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 ([CFStringPart] -> CFValue) -> [CFStringPart] -> CFValue
forall a b. (a -> b) -> a -> b
$ [String -> CFStringPart
CFStringVariable String
var | AssignmentMode
mode AssignmentMode -> AssignmentMode -> Bool
forall a. Eq a => a -> a -> Bool
== AssignmentMode
Append] [CFStringPart] -> [CFStringPart] -> [CFStringPart]
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 ([CFStringPart] -> CFValue) -> [CFStringPart] -> CFValue
forall a b. (a -> b) -> a -> b
$ [String -> CFStringPart
CFStringVariable String
var | AssignmentMode
mode AssignmentMode -> AssignmentMode -> Bool
forall a. Eq a => a -> a -> Bool
== AssignmentMode
Append] [CFStringPart] -> [CFStringPart] -> [CFStringPart]
forall a. [a] -> [a] -> [a]
++ Token -> [CFStringPart]
tokenToParts Token
t
                f Id
_ T_Array {} = CFValue
CFValueArray

    Id
-> Range
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     ()
registerNode (Token -> Id
getId Token
t) Range
op
    Range
-> RWS
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Range
forall a.
a
-> RWST
     CFContext
     ([LNode CFNode], [LEdge CFEdge], [(Id, (Node, Node))],
      [(Id, Node)])
     Node
     Identity
     a
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 -> (Token -> [CFStringPart]) -> [Token] -> [CFStringPart]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Token -> [CFStringPart]
tokenToParts [Token]
list
        T_DoubleQuoted Id
_ [Token]
list -> (Token -> [CFStringPart]) -> [Token] -> [CFStringPart]
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 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Token -> [String]
oversimplify Token
list) ]
        -- Check if getLiteralString can handle it, if not it's unknown
        Token
_ -> [CFStringPart
-> (String -> CFStringPart) -> Maybe String -> CFStringPart
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CFStringPart
CFStringUnknown String -> CFStringPart
CFStringLiteral (Maybe String -> CFStringPart) -> Maybe String -> CFStringPart
forall a b. (a -> b) -> a -> b
$ Token -> Maybe String
getLiteralString Token
t]


-- Like & but well defined when the node already exists
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 (Adj b, Node, a, Adj b) -> gr a b -> gr a b
forall a b. Context a b -> gr a b -> gr a b
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
Context a b -> gr a b -> gr a b
& (Node -> 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)

-- Change all subshell invocations to instead link directly to their contents.
-- This is used for producing dominator trees.
inlineSubshells :: CFGraph -> CFGraph
inlineSubshells :: CFGraph -> CFGraph
inlineSubshells CFGraph
graph = CFGraph
relinkedGraph
  where
    subshells :: [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)]
subshells = (Context CFNode CFEdge
 -> [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)]
 -> [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)])
-> [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)]
-> CFGraph
-> [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold Context CFNode CFEdge
-> [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)]
-> [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)]
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)(a, CFNode, Node, Node, e, f)
-> [(a, CFNode, Node, Node, e, f)]
-> [(a, CFNode, Node, Node, e, f)]
forall a. a -> [a] -> [a]
:[(a, CFNode, Node, Node, e, f)]
acc
            CFNode
_ -> [(a, CFNode, Node, Node, e, f)]
acc

    relinkedGraph :: CFGraph
relinkedGraph = (CFGraph
 -> (Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge) -> CFGraph)
-> CFGraph
-> [(Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge)]
-> CFGraph
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CFGraph
-> (Node, CFNode, Node, Node, Adj CFEdge, Adj CFEdge) -> CFGraph
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
            -- Link CFExecuteSubshell to the CFEntryPoint
            subshellToStart :: (Adj CFEdge, Node, a, Adj CFEdge)
subshellToStart = (Adj CFEdge
incoming, Node
node, a
label, [(CFEdge
CFEFlow, Node
start)])
            -- Link the subshell exit to the
            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
_) = gr a CFEdge -> Node -> (Adj CFEdge, Node, a, 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 (Adj CFEdge, Node, a, Adj CFEdge) -> gr a CFEdge -> gr a CFEdge
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 (Adj CFEdge, Node, a, Adj CFEdge) -> gr a CFEdge -> gr a CFEdge
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 = (Context CFNode CFEdge -> [Node] -> [Node])
-> [Node] -> CFGraph -> [Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold Context CFNode CFEdge -> [Node] -> [Node]
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 {} | t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
incoming -> a
nodea -> [a] -> [a]
forall 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 Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: CFGraph -> [Node]
findEntryNodes CFGraph
graph
    asLists :: [(Node, [Node])]
asLists = (Node -> [(Node, [Node])]) -> [Node] -> [(Node, [Node])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CFGraph -> Node -> [(Node, [Node])]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [(Node, [Node])]
dom CFGraph
inlined) [Node]
entryNodes
    asSetMap :: Map Node (Set Node)
asSetMap = [(Node, Set Node)] -> Map Node (Set Node)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Node, Set Node)] -> Map Node (Set Node))
-> [(Node, Set Node)] -> Map Node (Set Node)
forall a b. (a -> b) -> a -> b
$ ((Node, [Node]) -> (Node, Set Node))
-> [(Node, [Node])] -> [(Node, Set Node)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Node
node, [Node]
list) -> (Node
node, [Node] -> Set Node
forall a. Ord a => [a] -> Set a
S.fromList [Node]
list)) [(Node, [Node])]
asLists

findTerminalNodes :: CFGraph -> [Node]
findTerminalNodes :: CFGraph -> [Node]
findTerminalNodes CFGraph
graph = (Context CFNode CFEdge -> [Node] -> [Node])
-> [Node] -> CFGraph -> [Node]
forall (gr :: * -> * -> *) a b c.
Graph gr =>
(Context a b -> c -> c) -> c -> gr a b -> c
ufold Context CFNode CFEdge -> [Node] -> [Node]
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
nodeNode -> [Node] -> [Node]
forall 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
endNode -> [Node] -> [Node]
forall 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) = CFGraph -> Node -> Context CFNode CFEdge
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> Context a b
context CFGraph
graph Node
mainexit
    withExitEdges :: CFGraph
withExitEdges = (Adj CFEdge
incoming Adj CFEdge -> Adj CFEdge -> Adj CFEdge
forall a. [a] -> [a] -> [a]
++ (Node -> (CFEdge, Node)) -> [Node] -> Adj CFEdge
forall a b. (a -> b) -> [a] -> [b]
map (\Node
c -> (CFEdge
CFEFlow, Node
c)) [Node]
terminals, Node
mainexit, CFNode
label, Adj CFEdge
outgoing) Context CFNode CFEdge -> CFGraph -> CFGraph
forall {gr :: * -> * -> *} {b} {a}.
DynGraph gr =>
(Adj b, Node, a, Adj b) -> gr a b -> gr a b
`safeUpdate` CFGraph
inlined
    reversed :: CFGraph
reversed = CFGraph -> CFGraph
forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a b
grev CFGraph
withExitEdges
    postDoms :: [(Node, [Node])]
postDoms = CFGraph -> Node -> [(Node, [Node])]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Node -> [(Node, [Node])]
dom CFGraph
reversed Node
mainexit
    (Node
_, Node
maxNode) = CFGraph -> (Node, Node)
forall a b. Gr a b -> (Node, Node)
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> (Node, Node)
nodeRange CFGraph
graph
    -- Holes in the array cause "Exception: (Array.!): undefined array element" while
    -- inspecting/debugging, so fill the array first and then update.
    initializedArray :: Array Node [Node]
initializedArray = (Node, Node) -> [[Node]] -> Array Node [Node]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Node
0, Node
maxNode) ([[Node]] -> Array Node [Node]) -> [[Node]] -> Array Node [Node]
forall a b. (a -> b) -> a -> b
$ [Node] -> [[Node]]
forall a. a -> [a]
repeat []
    asArray :: Array Node [Node]
asArray = Array Node [Node]
initializedArray Array Node [Node] -> [(Node, [Node])] -> Array Node [Node]
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)] -> a i e
// [(Node, [Node])]
postDoms

return []
runTests :: IO Bool
runTests =  $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])