{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Group definitions by their dependencies
--
-- In order to do type inference properly, we need to solve constraints in groups and in a certain order:
--
-- 1. The constraints expressions that depend on definitions should be solved __after__ the constraints
--    of said definitions are solved
-- 2. The constraints of expressions that depend on one another should be solved __at the same time__
--
-- This module groups and orders definitions in order of their dependencies.
module Language.Giml.Rewrites.PreInfer.GroupDefsByDeps where

import Data.Generics.Uniplate.Data qualified as U
import Data.Graph qualified as G (SCC (..), flattenSCC, stronglyConnComp)
import Data.Map qualified as M
import Data.Set qualified as S
import Language.Giml.Syntax.Ast
import Language.Giml.Utils

-- | Reorder and group the definitions in a file in order of their dependencies.
rewrite :: forall a. ParsedFile a -> File a
rewrite :: forall a. ParsedFile a -> File a
rewrite (ParsedFile [Definition a]
defs) =
  let
    reach :: [((TermDef a), Var, [Var])]
    reach :: [(TermDef a, Var, [Var])]
reach =
      (Definition a -> Maybe (TermDef a, Var, [Var]))
-> [Definition a] -> [(TermDef a, Var, [Var])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        ( (TermDef a -> (TermDef a, Var, [Var]))
-> Maybe (TermDef a) -> Maybe (TermDef a, Var, [Var])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\TermDef a
def -> (TermDef a
def, TermDef a -> Var
forall a. TermDef a -> Var
getTermName TermDef a
def, Set Var -> [Var]
forall a. Set a -> [a]
S.toList (Set Var -> [Var]) -> Set Var -> [Var]
forall a b. (a -> b) -> a -> b
$ TermDef a -> Set Var
forall a. TermDef a -> Set Var
freeVars TermDef a
def)))
            (Maybe (TermDef a) -> Maybe (TermDef a, Var, [Var]))
-> (Definition a -> Maybe (TermDef a))
-> Definition a
-> Maybe (TermDef a, Var, [Var])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Definition a -> Maybe (TermDef a)
forall ann. Definition ann -> Maybe (TermDef ann)
getTermDef
        )
        [Definition a]
defs
    grouped :: [G.SCC (TermDef a)]
    grouped :: [SCC (TermDef a)]
grouped = [(TermDef a, Var, [Var])] -> [SCC (TermDef a)]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
G.stronglyConnComp [(TermDef a, Var, [Var])]
reach
  in
    [Datatype a] -> [[TermDef a]] -> File a
forall a. [Datatype a] -> [[TermDef a]] -> File a
File ((Definition a -> Maybe (Datatype a))
-> [Definition a] -> [Datatype a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Definition a -> Maybe (Datatype a)
forall ann. Definition ann -> Maybe (Datatype ann)
getTypeDef [Definition a]
defs) ((SCC (TermDef a) -> [TermDef a])
-> [SCC (TermDef a)] -> [[TermDef a]]
forall a b. (a -> b) -> [a] -> [b]
map SCC (TermDef a) -> [TermDef a]
forall vertex. SCC vertex -> [vertex]
G.flattenSCC [SCC (TermDef a)]
grouped)

-- ** Find dependencies

-- | The types that are bound in an expression.
type Scope = Set Var

-- | Calculate the free variables in a definition - these are the
--   top level definitions that this definition depends on.
freeVars :: TermDef a -> Set Var
freeVars :: forall a. TermDef a -> Set Var
freeVars = \case
  Variable a
_ Var
_ Maybe Type
_ Expr a
e ->
    Reader (Set Var) (Set Var) -> Set Var -> Set Var
forall r a. Reader r a -> r -> a
runReader (Expr a -> Reader (Set Var) (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e) Set Var
forall a. Monoid a => a
mempty
  Function a
_ Var
name Maybe Type
_ [Maybe Var]
args Expr a
e ->
    Reader (Set Var) (Set Var) -> Set Var -> Set Var
forall r a. Reader r a -> r -> a
runReader (Expr a -> Reader (Set Var) (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e) (Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
name (Set Var -> Set Var) -> Set Var -> Set Var
forall a b. (a -> b) -> a -> b
$ [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList ([Var] -> Set Var) -> [Var] -> Set Var
forall a b. (a -> b) -> a -> b
$ [Maybe Var] -> [Var]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Var]
args)

-- | The free variables in an expression.
freeVarsExpr :: (MonadReader Scope m) => Expr a -> m (Set Var)
freeVarsExpr :: forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr = \case
  EAnnotated a
_ Expr a
e ->
    Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e
  ELit {} ->
    Set Var -> m (Set Var)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Var
forall a. Monoid a => a
mempty
  EVar Var
var -> do
    Bool
ismember <- (Set Var -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Var
var)
    Set Var -> m (Set Var)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Var -> m (Set Var)) -> Set Var -> m (Set Var)
forall a b. (a -> b) -> a -> b
$ if Bool
ismember then Set Var
forall a. Monoid a => a
mempty else Var -> Set Var
forall a. a -> Set a
S.singleton Var
var
  EOp OpDef {Var
opName :: OpDef -> Var
opName :: Var
opName} -> do
    Bool
ismember <- (Set Var -> Bool) -> m Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Var
opName)
    Set Var -> m (Set Var)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Var -> m (Set Var)) -> Set Var -> m (Set Var)
forall a b. (a -> b) -> a -> b
$ if Bool
ismember then Set Var
forall a. Monoid a => a
mempty else Var -> Set Var
forall a. a -> Set a
S.singleton Var
opName
  EFun [Maybe Var]
args Expr a
expr ->
    (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union ([Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList ([Var] -> Set Var) -> [Var] -> Set Var
forall a b. (a -> b) -> a -> b
$ [Maybe Var] -> [Var]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Var]
args)) (m (Set Var) -> m (Set Var)) -> m (Set Var) -> m (Set Var)
forall a b. (a -> b) -> a -> b
$ Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
expr
  EFunCall Expr a
e1 [Expr a]
e2 ->
    ([Set Var] -> Set Var)
-> ([Set Var] -> [Set Var]) -> [Set Var] -> Set Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (([Set Var] -> [Set Var]) -> [Set Var] -> Set Var)
-> (Set Var -> [Set Var] -> [Set Var])
-> Set Var
-> [Set Var]
-> Set Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (Set Var -> [Set Var] -> Set Var)
-> m (Set Var) -> m ([Set Var] -> Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e1 m ([Set Var] -> Set Var) -> m [Set Var] -> m (Set Var)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr a -> m (Set Var)) -> [Expr a] -> m [Set Var]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr [Expr a]
e2
  EBlock Block a
block ->
    Block a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Block a -> m (Set Var)
freeVarsBlock Block a
block
  ELet (Variable a
_ Var
name Maybe Type
_ Expr a
e) Expr a
e' ->
    Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var)
-> m (Set Var) -> m (Set Var -> Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e m (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var) -> Set Var -> Set Var -> Set Var
forall a b. (a -> b) -> a -> b
$ Var -> Set Var
forall a. a -> Set a
S.singleton Var
name) (Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e')
  ELet (Function a
_ Var
name Maybe Type
_ [Maybe Var]
args Expr a
e) Expr a
e' ->
    Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union
      (Set Var -> Set Var -> Set Var)
-> m (Set Var) -> m (Set Var -> Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
name (Set Var -> Set Var) -> Set Var -> Set Var
forall a b. (a -> b) -> a -> b
$ [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList ([Var] -> Set Var) -> [Var] -> Set Var
forall a b. (a -> b) -> a -> b
$ [Maybe Var] -> [Var]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Var]
args)) (Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e)
      m (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var) -> Set Var -> Set Var -> Set Var
forall a b. (a -> b) -> a -> b
$ Var -> Set Var
forall a. a -> Set a
S.singleton Var
name) (Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e')
  EVariant {} ->
    Set Var -> m (Set Var)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Var
forall a. Monoid a => a
mempty
  EOpenVariant {} ->
    Set Var -> m (Set Var)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Var
forall a. Monoid a => a
mempty
  ERecord Record (Expr a)
record ->
    [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set Var] -> Set Var) -> m [Set Var] -> m (Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr a -> m (Set Var)) -> [Expr a] -> m [Set Var]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr (Record (Expr a) -> [Expr a]
forall k a. Map k a -> [a]
M.elems Record (Expr a)
record)
  ERecordAccess Expr a
e Label
_ ->
    Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e
  ERecordExtension Record (Expr a)
record Expr a
ext ->
    ([Set Var] -> Set Var)
-> ([Set Var] -> [Set Var]) -> [Set Var] -> Set Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (([Set Var] -> [Set Var]) -> [Set Var] -> Set Var)
-> (Set Var -> [Set Var] -> [Set Var])
-> Set Var
-> [Set Var]
-> Set Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) (Set Var -> [Set Var] -> Set Var)
-> m (Set Var) -> m ([Set Var] -> Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
ext m ([Set Var] -> Set Var) -> m [Set Var] -> m (Set Var)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr a -> m (Set Var)) -> [Expr a] -> m [Set Var]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr (Record (Expr a) -> [Expr a]
forall k a. Map k a -> [a]
M.elems Record (Expr a)
record)
  ECase Expr a
e [(Pattern, Expr a)]
pats ->
    ([Set Var] -> Set Var)
-> ([Set Var] -> [Set Var]) -> [Set Var] -> Set Var
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (([Set Var] -> [Set Var]) -> [Set Var] -> Set Var)
-> (Set Var -> [Set Var] -> [Set Var])
-> Set Var
-> [Set Var]
-> Set Var
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)
      (Set Var -> [Set Var] -> Set Var)
-> m (Set Var) -> m ([Set Var] -> Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e
      m ([Set Var] -> Set Var) -> m [Set Var] -> m (Set Var)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Pattern, Expr a) -> m (Set Var))
-> [(Pattern, Expr a)] -> m [Set Var]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Pattern, Expr a) -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
(Pattern, Expr a) -> m (Set Var)
freeVarsPat [(Pattern, Expr a)]
pats
  EIf Expr a
e1 Expr a
e2 Expr a
e3 ->
    [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set Var] -> Set Var) -> m [Set Var] -> m (Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr a -> m (Set Var)) -> [Expr a] -> m [Set Var]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr [Expr a
e1, Expr a
e2, Expr a
e3]
  EFfi Var
_ Maybe Type
_ [Expr a]
exprs ->
    [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set Var] -> Set Var) -> m [Set Var] -> m (Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr a -> m (Set Var)) -> [Expr a] -> m [Set Var]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr [Expr a]
exprs

-- | The free variables on a single @pattern -> body@ pair.
freeVarsPat :: (MonadReader Scope m) => (Pattern, Expr a) -> m (Set Var)
freeVarsPat :: forall (m :: * -> *) a.
MonadReader (Set Var) m =>
(Pattern, Expr a) -> m (Set Var)
freeVarsPat (Pattern
pat, Expr a
expr) =
  let
    captures :: [Var]
captures = [Var
var | PVar Var
var <- Pattern -> [Pattern]
forall on. Uniplate on => on -> [on]
U.universe Pattern
pat]
  in
    (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var) -> Set Var -> Set Var -> Set Var
forall a b. (a -> b) -> a -> b
$ [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var]
captures) (Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
expr)

-- | The free variables in a block.
freeVarsBlock :: (MonadReader Scope m) => Block a -> m (Set Var)
freeVarsBlock :: forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Block a -> m (Set Var)
freeVarsBlock = \case
  [] -> Set Var -> m (Set Var)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Var
forall a. Monoid a => a
mempty
  SExpr a
_ Expr a
e : Block a
block ->
    Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var)
-> m (Set Var) -> m (Set Var -> Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e m (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Block a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Block a -> m (Set Var)
freeVarsBlock Block a
block
  SDef a
_ (Variable a
_ Var
name Maybe Type
_ Expr a
e) : Block a
block ->
    Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var)
-> m (Set Var) -> m (Set Var -> Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e m (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var) -> Set Var -> Set Var -> Set Var
forall a b. (a -> b) -> a -> b
$ Var -> Set Var
forall a. a -> Set a
S.singleton Var
name) (Block a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Block a -> m (Set Var)
freeVarsBlock Block a
block)
  SDef a
_ (Function a
_ Var
name Maybe Type
_ [Maybe Var]
args Expr a
e) : Block a
block ->
    Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union
      (Set Var -> Set Var -> Set Var)
-> m (Set Var) -> m (Set Var -> Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
name (Set Var -> Set Var) -> Set Var -> Set Var
forall a b. (a -> b) -> a -> b
$ [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList ([Var] -> Set Var) -> [Var] -> Set Var
forall a b. (a -> b) -> a -> b
$ [Maybe Var] -> [Var]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Var]
args)) (Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e)
      m (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var) -> Set Var -> Set Var -> Set Var
forall a b. (a -> b) -> a -> b
$ Var -> Set Var
forall a. a -> Set a
S.singleton Var
name) (Block a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Block a -> m (Set Var)
freeVarsBlock Block a
block)
  SBind a
_ Var
name Expr a
e : Block a
block ->
    Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var)
-> m (Set Var) -> m (Set Var -> Set Var)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Expr a -> m (Set Var)
freeVarsExpr Expr a
e m (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set Var -> Set Var) -> m (Set Var) -> m (Set Var)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
S.union (Set Var -> Set Var -> Set Var) -> Set Var -> Set Var -> Set Var
forall a b. (a -> b) -> a -> b
$ Var -> Set Var
forall a. a -> Set a
S.singleton Var
name) (Block a -> m (Set Var)
forall (m :: * -> *) a.
MonadReader (Set Var) m =>
Block a -> m (Set Var)
freeVarsBlock Block a
block)