{-# language ConstraintKinds #-}
{-# language CPP #-}
{-# language DataKinds #-}
{-# language GADTs #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# options_ghc -fno-warn-name-shadowing #-}
{-# options_ghc -Wno-missing-methods #-}
module Nix.Lint where
import Nix.Prelude
import Relude.Unsafe as Unsafe ( head )
import Control.Exception ( throw )
import GHC.Exception ( ErrorCall(ErrorCall) )
import Control.Monad ( foldM )
import Control.Monad.Catch
import Control.Monad.Fix
import Control.Monad.Ref
import Control.Monad.ST
import qualified Data.HashMap.Lazy as M
import Data.List ( intersect )
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as Text
import qualified Text.Show
import Nix.Atoms
import Nix.Context
import Nix.Convert
import Nix.Eval ( MonadEval(..) )
import qualified Nix.Eval as Eval
import Nix.Expr.Types
import Nix.Expr.Types.Annotated
import Nix.Frames
import Nix.Fresh
import Nix.String
import Nix.Options
import Nix.Scope
import Nix.Thunk
import Nix.Thunk.Basic
import Nix.Value.Monad
data TAtom
= TInt
| TFloat
| TBool
| TNull
deriving (Int -> TAtom -> ShowS
[TAtom] -> ShowS
TAtom -> String
(Int -> TAtom -> ShowS)
-> (TAtom -> String) -> ([TAtom] -> ShowS) -> Show TAtom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TAtom] -> ShowS
$cshowList :: [TAtom] -> ShowS
show :: TAtom -> String
$cshow :: TAtom -> String
showsPrec :: Int -> TAtom -> ShowS
$cshowsPrec :: Int -> TAtom -> ShowS
Show, TAtom -> TAtom -> Bool
(TAtom -> TAtom -> Bool) -> (TAtom -> TAtom -> Bool) -> Eq TAtom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TAtom -> TAtom -> Bool
$c/= :: TAtom -> TAtom -> Bool
== :: TAtom -> TAtom -> Bool
$c== :: TAtom -> TAtom -> Bool
Eq, Eq TAtom
Eq TAtom
-> (TAtom -> TAtom -> Ordering)
-> (TAtom -> TAtom -> Bool)
-> (TAtom -> TAtom -> Bool)
-> (TAtom -> TAtom -> Bool)
-> (TAtom -> TAtom -> Bool)
-> (TAtom -> TAtom -> TAtom)
-> (TAtom -> TAtom -> TAtom)
-> Ord TAtom
TAtom -> TAtom -> Bool
TAtom -> TAtom -> Ordering
TAtom -> TAtom -> TAtom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TAtom -> TAtom -> TAtom
$cmin :: TAtom -> TAtom -> TAtom
max :: TAtom -> TAtom -> TAtom
$cmax :: TAtom -> TAtom -> TAtom
>= :: TAtom -> TAtom -> Bool
$c>= :: TAtom -> TAtom -> Bool
> :: TAtom -> TAtom -> Bool
$c> :: TAtom -> TAtom -> Bool
<= :: TAtom -> TAtom -> Bool
$c<= :: TAtom -> TAtom -> Bool
< :: TAtom -> TAtom -> Bool
$c< :: TAtom -> TAtom -> Bool
compare :: TAtom -> TAtom -> Ordering
$ccompare :: TAtom -> TAtom -> Ordering
$cp1Ord :: Eq TAtom
Ord)
data NTypeF (m :: Type -> Type) r
= TConstant [TAtom]
| TStr
| TList r
| TSet (Maybe (AttrSet r))
| TClosure (Params ())
| TPath
| TBuiltin Text (Symbolic m -> m r)
deriving a -> NTypeF m b -> NTypeF m a
(a -> b) -> NTypeF m a -> NTypeF m b
(forall a b. (a -> b) -> NTypeF m a -> NTypeF m b)
-> (forall a b. a -> NTypeF m b -> NTypeF m a)
-> Functor (NTypeF m)
forall a b. a -> NTypeF m b -> NTypeF m a
forall a b. (a -> b) -> NTypeF m a -> NTypeF m b
forall (m :: * -> *) a b.
Functor m =>
a -> NTypeF m b -> NTypeF m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NTypeF m a -> NTypeF m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NTypeF m b -> NTypeF m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> NTypeF m b -> NTypeF m a
fmap :: (a -> b) -> NTypeF m a -> NTypeF m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NTypeF m a -> NTypeF m b
Functor
compareTypes :: NTypeF m r -> NTypeF m r -> Ordering
compareTypes :: NTypeF m r -> NTypeF m r -> Ordering
compareTypes (TConstant [TAtom]
_) (TConstant [TAtom]
_) = Ordering
EQ
compareTypes (TConstant [TAtom]
_) NTypeF m r
_ = Ordering
LT
compareTypes NTypeF m r
_ (TConstant [TAtom]
_) = Ordering
GT
compareTypes NTypeF m r
TStr NTypeF m r
TStr = Ordering
EQ
compareTypes NTypeF m r
TStr NTypeF m r
_ = Ordering
LT
compareTypes NTypeF m r
_ NTypeF m r
TStr = Ordering
GT
compareTypes (TList r
_) (TList r
_) = Ordering
EQ
compareTypes (TList r
_) NTypeF m r
_ = Ordering
LT
compareTypes NTypeF m r
_ (TList r
_) = Ordering
GT
compareTypes (TSet Maybe (AttrSet r)
_) (TSet Maybe (AttrSet r)
_) = Ordering
EQ
compareTypes (TSet Maybe (AttrSet r)
_) NTypeF m r
_ = Ordering
LT
compareTypes NTypeF m r
_ (TSet Maybe (AttrSet r)
_) = Ordering
GT
compareTypes TClosure{} TClosure{} = Ordering
EQ
compareTypes TClosure{} NTypeF m r
_ = Ordering
LT
compareTypes NTypeF m r
_ TClosure{} = Ordering
GT
compareTypes NTypeF m r
TPath NTypeF m r
TPath = Ordering
EQ
compareTypes NTypeF m r
TPath NTypeF m r
_ = Ordering
LT
compareTypes NTypeF m r
_ NTypeF m r
TPath = Ordering
GT
compareTypes (TBuiltin Text
_ Symbolic m -> m r
_) (TBuiltin Text
_ Symbolic m -> m r
_) = Ordering
EQ
data NSymbolicF r
= NAny
| NMany [r]
deriving (Int -> NSymbolicF r -> ShowS
[NSymbolicF r] -> ShowS
NSymbolicF r -> String
(Int -> NSymbolicF r -> ShowS)
-> (NSymbolicF r -> String)
-> ([NSymbolicF r] -> ShowS)
-> Show (NSymbolicF r)
forall r. Show r => Int -> NSymbolicF r -> ShowS
forall r. Show r => [NSymbolicF r] -> ShowS
forall r. Show r => NSymbolicF r -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NSymbolicF r] -> ShowS
$cshowList :: forall r. Show r => [NSymbolicF r] -> ShowS
show :: NSymbolicF r -> String
$cshow :: forall r. Show r => NSymbolicF r -> String
showsPrec :: Int -> NSymbolicF r -> ShowS
$cshowsPrec :: forall r. Show r => Int -> NSymbolicF r -> ShowS
Show, NSymbolicF r -> NSymbolicF r -> Bool
(NSymbolicF r -> NSymbolicF r -> Bool)
-> (NSymbolicF r -> NSymbolicF r -> Bool) -> Eq (NSymbolicF r)
forall r. Eq r => NSymbolicF r -> NSymbolicF r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NSymbolicF r -> NSymbolicF r -> Bool
$c/= :: forall r. Eq r => NSymbolicF r -> NSymbolicF r -> Bool
== :: NSymbolicF r -> NSymbolicF r -> Bool
$c== :: forall r. Eq r => NSymbolicF r -> NSymbolicF r -> Bool
Eq, Eq (NSymbolicF r)
Eq (NSymbolicF r)
-> (NSymbolicF r -> NSymbolicF r -> Ordering)
-> (NSymbolicF r -> NSymbolicF r -> Bool)
-> (NSymbolicF r -> NSymbolicF r -> Bool)
-> (NSymbolicF r -> NSymbolicF r -> Bool)
-> (NSymbolicF r -> NSymbolicF r -> Bool)
-> (NSymbolicF r -> NSymbolicF r -> NSymbolicF r)
-> (NSymbolicF r -> NSymbolicF r -> NSymbolicF r)
-> Ord (NSymbolicF r)
NSymbolicF r -> NSymbolicF r -> Bool
NSymbolicF r -> NSymbolicF r -> Ordering
NSymbolicF r -> NSymbolicF r -> NSymbolicF r
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 r. Ord r => Eq (NSymbolicF r)
forall r. Ord r => NSymbolicF r -> NSymbolicF r -> Bool
forall r. Ord r => NSymbolicF r -> NSymbolicF r -> Ordering
forall r. Ord r => NSymbolicF r -> NSymbolicF r -> NSymbolicF r
min :: NSymbolicF r -> NSymbolicF r -> NSymbolicF r
$cmin :: forall r. Ord r => NSymbolicF r -> NSymbolicF r -> NSymbolicF r
max :: NSymbolicF r -> NSymbolicF r -> NSymbolicF r
$cmax :: forall r. Ord r => NSymbolicF r -> NSymbolicF r -> NSymbolicF r
>= :: NSymbolicF r -> NSymbolicF r -> Bool
$c>= :: forall r. Ord r => NSymbolicF r -> NSymbolicF r -> Bool
> :: NSymbolicF r -> NSymbolicF r -> Bool
$c> :: forall r. Ord r => NSymbolicF r -> NSymbolicF r -> Bool
<= :: NSymbolicF r -> NSymbolicF r -> Bool
$c<= :: forall r. Ord r => NSymbolicF r -> NSymbolicF r -> Bool
< :: NSymbolicF r -> NSymbolicF r -> Bool
$c< :: forall r. Ord r => NSymbolicF r -> NSymbolicF r -> Bool
compare :: NSymbolicF r -> NSymbolicF r -> Ordering
$ccompare :: forall r. Ord r => NSymbolicF r -> NSymbolicF r -> Ordering
$cp1Ord :: forall r. Ord r => Eq (NSymbolicF r)
Ord, a -> NSymbolicF b -> NSymbolicF a
(a -> b) -> NSymbolicF a -> NSymbolicF b
(forall a b. (a -> b) -> NSymbolicF a -> NSymbolicF b)
-> (forall a b. a -> NSymbolicF b -> NSymbolicF a)
-> Functor NSymbolicF
forall a b. a -> NSymbolicF b -> NSymbolicF a
forall a b. (a -> b) -> NSymbolicF a -> NSymbolicF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NSymbolicF b -> NSymbolicF a
$c<$ :: forall a b. a -> NSymbolicF b -> NSymbolicF a
fmap :: (a -> b) -> NSymbolicF a -> NSymbolicF b
$cfmap :: forall a b. (a -> b) -> NSymbolicF a -> NSymbolicF b
Functor, NSymbolicF a -> Bool
(a -> m) -> NSymbolicF a -> m
(a -> b -> b) -> b -> NSymbolicF a -> b
(forall m. Monoid m => NSymbolicF m -> m)
-> (forall m a. Monoid m => (a -> m) -> NSymbolicF a -> m)
-> (forall m a. Monoid m => (a -> m) -> NSymbolicF a -> m)
-> (forall a b. (a -> b -> b) -> b -> NSymbolicF a -> b)
-> (forall a b. (a -> b -> b) -> b -> NSymbolicF a -> b)
-> (forall b a. (b -> a -> b) -> b -> NSymbolicF a -> b)
-> (forall b a. (b -> a -> b) -> b -> NSymbolicF a -> b)
-> (forall a. (a -> a -> a) -> NSymbolicF a -> a)
-> (forall a. (a -> a -> a) -> NSymbolicF a -> a)
-> (forall a. NSymbolicF a -> [a])
-> (forall a. NSymbolicF a -> Bool)
-> (forall a. NSymbolicF a -> Int)
-> (forall a. Eq a => a -> NSymbolicF a -> Bool)
-> (forall a. Ord a => NSymbolicF a -> a)
-> (forall a. Ord a => NSymbolicF a -> a)
-> (forall a. Num a => NSymbolicF a -> a)
-> (forall a. Num a => NSymbolicF a -> a)
-> Foldable NSymbolicF
forall a. Eq a => a -> NSymbolicF a -> Bool
forall a. Num a => NSymbolicF a -> a
forall a. Ord a => NSymbolicF a -> a
forall m. Monoid m => NSymbolicF m -> m
forall a. NSymbolicF a -> Bool
forall a. NSymbolicF a -> Int
forall a. NSymbolicF a -> [a]
forall a. (a -> a -> a) -> NSymbolicF a -> a
forall m a. Monoid m => (a -> m) -> NSymbolicF a -> m
forall b a. (b -> a -> b) -> b -> NSymbolicF a -> b
forall a b. (a -> b -> b) -> b -> NSymbolicF a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: NSymbolicF a -> a
$cproduct :: forall a. Num a => NSymbolicF a -> a
sum :: NSymbolicF a -> a
$csum :: forall a. Num a => NSymbolicF a -> a
minimum :: NSymbolicF a -> a
$cminimum :: forall a. Ord a => NSymbolicF a -> a
maximum :: NSymbolicF a -> a
$cmaximum :: forall a. Ord a => NSymbolicF a -> a
elem :: a -> NSymbolicF a -> Bool
$celem :: forall a. Eq a => a -> NSymbolicF a -> Bool
length :: NSymbolicF a -> Int
$clength :: forall a. NSymbolicF a -> Int
null :: NSymbolicF a -> Bool
$cnull :: forall a. NSymbolicF a -> Bool
toList :: NSymbolicF a -> [a]
$ctoList :: forall a. NSymbolicF a -> [a]
foldl1 :: (a -> a -> a) -> NSymbolicF a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NSymbolicF a -> a
foldr1 :: (a -> a -> a) -> NSymbolicF a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> NSymbolicF a -> a
foldl' :: (b -> a -> b) -> b -> NSymbolicF a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NSymbolicF a -> b
foldl :: (b -> a -> b) -> b -> NSymbolicF a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NSymbolicF a -> b
foldr' :: (a -> b -> b) -> b -> NSymbolicF a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NSymbolicF a -> b
foldr :: (a -> b -> b) -> b -> NSymbolicF a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> NSymbolicF a -> b
foldMap' :: (a -> m) -> NSymbolicF a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NSymbolicF a -> m
foldMap :: (a -> m) -> NSymbolicF a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NSymbolicF a -> m
fold :: NSymbolicF m -> m
$cfold :: forall m. Monoid m => NSymbolicF m -> m
Foldable, Functor NSymbolicF
Foldable NSymbolicF
Functor NSymbolicF
-> Foldable NSymbolicF
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NSymbolicF a -> f (NSymbolicF b))
-> (forall (f :: * -> *) a.
Applicative f =>
NSymbolicF (f a) -> f (NSymbolicF a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NSymbolicF a -> m (NSymbolicF b))
-> (forall (m :: * -> *) a.
Monad m =>
NSymbolicF (m a) -> m (NSymbolicF a))
-> Traversable NSymbolicF
(a -> f b) -> NSymbolicF a -> f (NSymbolicF b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
NSymbolicF (m a) -> m (NSymbolicF a)
forall (f :: * -> *) a.
Applicative f =>
NSymbolicF (f a) -> f (NSymbolicF a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NSymbolicF a -> m (NSymbolicF b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NSymbolicF a -> f (NSymbolicF b)
sequence :: NSymbolicF (m a) -> m (NSymbolicF a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
NSymbolicF (m a) -> m (NSymbolicF a)
mapM :: (a -> m b) -> NSymbolicF a -> m (NSymbolicF b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NSymbolicF a -> m (NSymbolicF b)
sequenceA :: NSymbolicF (f a) -> f (NSymbolicF a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NSymbolicF (f a) -> f (NSymbolicF a)
traverse :: (a -> f b) -> NSymbolicF a -> f (NSymbolicF b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NSymbolicF a -> f (NSymbolicF b)
$cp2Traversable :: Foldable NSymbolicF
$cp1Traversable :: Functor NSymbolicF
Traversable)
type SThunk (m :: Type -> Type) = NThunkF m (Symbolic m)
type SValue (m :: Type -> Type) = Ref m (NSymbolicF (NTypeF m (Symbolic m)))
data Symbolic m = SV { Symbolic m -> SValue m
getSV :: SValue m } | ST { Symbolic m -> SThunk m
getST :: SThunk m }
instance Show (Symbolic m) where
show :: Symbolic m -> String
show Symbolic m
_ = String
"<symbolic>"
everyPossible
:: MonadAtomicRef m
=> m (Symbolic m)
everyPossible :: m (Symbolic m)
everyPossible = NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
packSymbolic NSymbolicF (NTypeF m (Symbolic m))
forall r. NSymbolicF r
NAny
mkSymbolic
:: MonadAtomicRef m
=> [NTypeF m (Symbolic m)]
-> m (Symbolic m)
mkSymbolic :: [NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic = NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
packSymbolic (NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m))
-> ([NTypeF m (Symbolic m)] -> NSymbolicF (NTypeF m (Symbolic m)))
-> [NTypeF m (Symbolic m)]
-> m (Symbolic m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NTypeF m (Symbolic m)] -> NSymbolicF (NTypeF m (Symbolic m))
forall r. [r] -> NSymbolicF r
NMany
packSymbolic
:: MonadAtomicRef m
=> NSymbolicF (NTypeF m (Symbolic m))
-> m (Symbolic m)
packSymbolic :: NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
packSymbolic = (Ref m (NSymbolicF (NTypeF m (Symbolic m))) -> Symbolic m)
-> m (Ref m (NSymbolicF (NTypeF m (Symbolic m)))) -> m (Symbolic m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref m (NSymbolicF (NTypeF m (Symbolic m))) -> Symbolic m
forall (m :: * -> *). SValue m -> Symbolic m
SV (m (Ref m (NSymbolicF (NTypeF m (Symbolic m)))) -> m (Symbolic m))
-> (NSymbolicF (NTypeF m (Symbolic m))
-> m (Ref m (NSymbolicF (NTypeF m (Symbolic m)))))
-> NSymbolicF (NTypeF m (Symbolic m))
-> m (Symbolic m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NSymbolicF (NTypeF m (Symbolic m))
-> m (Ref m (NSymbolicF (NTypeF m (Symbolic m))))
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
unpackSymbolic
:: (MonadAtomicRef m, MonadThunkId m, MonadCatch m)
=> Symbolic m
-> m (NSymbolicF (NTypeF m (Symbolic m)))
unpackSymbolic :: Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
unpackSymbolic = Ref m (NSymbolicF (NTypeF m (Symbolic m)))
-> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef (Ref m (NSymbolicF (NTypeF m (Symbolic m)))
-> m (NSymbolicF (NTypeF m (Symbolic m))))
-> (Symbolic m -> Ref m (NSymbolicF (NTypeF m (Symbolic m))))
-> Symbolic m
-> m (NSymbolicF (NTypeF m (Symbolic m)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbolic m -> Ref m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *). Symbolic m -> SValue m
getSV (Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m))))
-> (Symbolic m -> m (Symbolic m))
-> Symbolic m
-> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Symbolic m -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand
type MonadLint e m =
( Scoped (Symbolic m) m
, Framed e m
, MonadAtomicRef m
, MonadCatch m
, MonadThunkId m
)
symerr :: forall e m a . MonadLint e m => Text -> m a
symerr :: Text -> m a
symerr = forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
forall (m :: * -> *) s a.
(MonadEval (Symbolic m) m, Exception s) =>
s -> m a
evalError @(Symbolic m) (ErrorCall -> m a) -> (Text -> ErrorCall) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ErrorCall
ErrorCall (String -> ErrorCall) -> (Text -> String) -> Text -> ErrorCall
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString
renderSymbolic :: MonadLint e m => Symbolic m -> m Text
renderSymbolic :: Symbolic m -> m Text
renderSymbolic =
(\case
NSymbolicF (NTypeF m (Symbolic m))
NAny -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"<any>"
NMany [NTypeF m (Symbolic m)]
xs ->
Text -> [Text] -> Text
Text.intercalate Text
", " ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(NTypeF m (Symbolic m) -> m Text)
-> [NTypeF m (Symbolic m)] -> m [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
(\case
TConstant [TAtom]
ys ->
Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$
Text -> [Text] -> Text
Text.intercalate Text
", "
((TAtom -> Text) -> [TAtom] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\case
TAtom
TInt -> Text
"int"
TAtom
TFloat -> Text
"float"
TAtom
TBool -> Text
"bool"
TAtom
TNull -> Text
"null"
)
[TAtom]
ys
)
NTypeF m (Symbolic m)
TStr -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"string"
TList Symbolic m
r ->
(Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
brackets (m Text -> m Text) -> m Text -> m Text
forall a b. (a -> b) -> a -> b
$ Symbolic m -> m Text
forall e (m :: * -> *). MonadLint e m => Symbolic m -> m Text
renderSymbolic (Symbolic m -> m Text) -> m (Symbolic m) -> m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Symbolic m -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand Symbolic m
r
TSet Maybe (AttrSet (Symbolic m))
Nothing -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"<any set>"
TSet (Just AttrSet (Symbolic m)
s) ->
Text -> Text
braces (Text -> Text)
-> (HashMap VarName Text -> Text) -> HashMap VarName Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap VarName Text -> Text
forall b a. (Show a, IsString b) => a -> b
show (HashMap VarName Text -> Text)
-> m (HashMap VarName Text) -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Symbolic m -> m Text)
-> AttrSet (Symbolic m) -> m (HashMap VarName Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbolic m -> m Text
forall e (m :: * -> *). MonadLint e m => Symbolic m -> m Text
renderSymbolic (Symbolic m -> m Text)
-> (Symbolic m -> m (Symbolic m)) -> Symbolic m -> m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Symbolic m -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand) AttrSet (Symbolic m)
s
f :: NTypeF m (Symbolic m)
f@(TClosure Params ()
p) ->
do
(AttrSet (Symbolic m)
args, Symbolic m
sym) <-
do
Symbolic m
f' <- [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one OneItem [NTypeF m (Symbolic m)]
NTypeF m (Symbolic m)
f
NExprF ()
-> Symbolic m
-> m (Symbolic m)
-> m (AttrSet (Symbolic m), Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF ()
-> Symbolic m
-> m (Symbolic m)
-> m (HashMap VarName (Symbolic m), Symbolic m)
lintApp (Params () -> () -> NExprF ()
forall r. Params r -> r -> NExprF r
NAbs Params ()
p ()
forall a. Monoid a => a
mempty) Symbolic m
f' m (Symbolic m)
forall (m :: * -> *). MonadAtomicRef m => m (Symbolic m)
everyPossible
HashMap VarName Text
args' <- (Symbolic m -> m Text)
-> AttrSet (Symbolic m) -> m (HashMap VarName Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Symbolic m -> m Text
forall e (m :: * -> *). MonadLint e m => Symbolic m -> m Text
renderSymbolic AttrSet (Symbolic m)
args
Text
sym' <- Symbolic m -> m Text
forall e (m :: * -> *). MonadLint e m => Symbolic m -> m Text
renderSymbolic Symbolic m
sym
pure $ Text -> Text
parens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HashMap VarName Text -> Text
forall b a. (Show a, IsString b) => a -> b
show HashMap VarName Text
args' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" -> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sym'
NTypeF m (Symbolic m)
TPath -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"path"
TBuiltin Text
_n Symbolic m -> m (Symbolic m)
_f -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"<builtin function>"
)
[NTypeF m (Symbolic m)]
xs
) (NSymbolicF (NTypeF m (Symbolic m)) -> m Text)
-> (Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m))))
-> Symbolic m
-> m Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *).
(MonadAtomicRef m, MonadThunkId m, MonadCatch m) =>
Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
unpackSymbolic
where
between :: a -> a -> a -> a
between a
a a
b a
c = a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c
parens :: Text -> Text
parens = Text -> Text -> Text -> Text
forall a. Semigroup a => a -> a -> a -> a
between Text
"(" Text
")"
brackets :: Text -> Text
brackets = Text -> Text -> Text -> Text
forall a. Semigroup a => a -> a -> a -> a
between Text
"[" Text
"]"
braces :: Text -> Text
braces = Text -> Text -> Text -> Text
forall a. Semigroup a => a -> a -> a -> a
between Text
"{" Text
"}"
merge
:: forall e m
. MonadLint e m
=> NExprF ()
-> [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)]
-> m [NTypeF m (Symbolic m)]
merge :: NExprF ()
-> [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)]
-> m [NTypeF m (Symbolic m)]
merge NExprF ()
context = [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
go
where
go
:: [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)]
-> m [NTypeF m (Symbolic m)]
go :: [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
go [] [NTypeF m (Symbolic m)]
_ = m [NTypeF m (Symbolic m)]
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
go [NTypeF m (Symbolic m)]
_ [] = m [NTypeF m (Symbolic m)]
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
go xxs :: [NTypeF m (Symbolic m)]
xxs@(NTypeF m (Symbolic m)
x : [NTypeF m (Symbolic m)]
xs) yys :: [NTypeF m (Symbolic m)]
yys@(NTypeF m (Symbolic m)
y : [NTypeF m (Symbolic m)]
ys) = case (NTypeF m (Symbolic m)
x, NTypeF m (Symbolic m)
y) of
(NTypeF m (Symbolic m)
TStr , NTypeF m (Symbolic m)
TStr ) -> (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one OneItem [NTypeF m (Symbolic m)]
forall (m :: * -> *) r. NTypeF m r
TStr [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a. Semigroup a => a -> a -> a
<>) ([NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [NTypeF m (Symbolic m)]
rest
(NTypeF m (Symbolic m)
TPath, NTypeF m (Symbolic m)
TPath) -> (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one OneItem [NTypeF m (Symbolic m)]
forall (m :: * -> *) r. NTypeF m r
TPath [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a. Semigroup a => a -> a -> a
<>) ([NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [NTypeF m (Symbolic m)]
rest
(TConstant [TAtom]
ls, TConstant [TAtom]
rs) ->
(OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one ([TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom]
ls [TAtom] -> [TAtom] -> [TAtom]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [TAtom]
rs)) [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a. Semigroup a => a -> a -> a
<>) ([NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [NTypeF m (Symbolic m)]
rest
(TList Symbolic m
l, TList Symbolic m
r) ->
do
Symbolic m
l' <- Symbolic m -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand Symbolic m
l
Symbolic m
r' <- Symbolic m -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand Symbolic m
r
Symbolic m
m <- m (Symbolic m) -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer (m (Symbolic m) -> m (Symbolic m))
-> m (Symbolic m) -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
unify NExprF ()
context Symbolic m
l' Symbolic m
r'
(OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (Symbolic m -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. r -> NTypeF m r
TList Symbolic m
m) [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a. Semigroup a => a -> a -> a
<>) ([NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [NTypeF m (Symbolic m)]
rest
(TSet Maybe (AttrSet (Symbolic m))
x , TSet Maybe (AttrSet (Symbolic m))
Nothing ) -> (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (Maybe (AttrSet (Symbolic m)) -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. Maybe (AttrSet r) -> NTypeF m r
TSet Maybe (AttrSet (Symbolic m))
x) [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a. Semigroup a => a -> a -> a
<>) ([NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [NTypeF m (Symbolic m)]
rest
(TSet Maybe (AttrSet (Symbolic m))
Nothing , TSet Maybe (AttrSet (Symbolic m))
x ) -> (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (Maybe (AttrSet (Symbolic m)) -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. Maybe (AttrSet r) -> NTypeF m r
TSet Maybe (AttrSet (Symbolic m))
x) [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a. Semigroup a => a -> a -> a
<>) ([NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [NTypeF m (Symbolic m)]
rest
(TSet (Just AttrSet (Symbolic m)
l), TSet (Just AttrSet (Symbolic m)
r)) -> do
AttrSet (Symbolic m)
m <- HashMap VarName (m (Symbolic m)) -> m (AttrSet (Symbolic m))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (HashMap VarName (m (Symbolic m)) -> m (AttrSet (Symbolic m)))
-> HashMap VarName (m (Symbolic m)) -> m (AttrSet (Symbolic m))
forall a b. (a -> b) -> a -> b
$ (m (Symbolic m) -> m (Symbolic m) -> m (Symbolic m))
-> HashMap VarName (m (Symbolic m))
-> HashMap VarName (m (Symbolic m))
-> HashMap VarName (m (Symbolic m))
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
M.intersectionWith
(\ m (Symbolic m)
i m (Symbolic m)
j ->
do
Symbolic m
i'' <- Symbolic m -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand (Symbolic m -> m (Symbolic m)) -> m (Symbolic m) -> m (Symbolic m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Symbolic m)
i
Symbolic m
j'' <- Symbolic m -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand (Symbolic m -> m (Symbolic m)) -> m (Symbolic m) -> m (Symbolic m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Symbolic m)
j
(m (Symbolic m) -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer (m (Symbolic m) -> m (Symbolic m))
-> (Symbolic m -> m (Symbolic m)) -> Symbolic m -> m (Symbolic m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
unify NExprF ()
context Symbolic m
i'') Symbolic m
j''
)
(Symbolic m -> m (Symbolic m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbolic m -> m (Symbolic m))
-> AttrSet (Symbolic m) -> HashMap VarName (m (Symbolic m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrSet (Symbolic m)
l)
(Symbolic m -> m (Symbolic m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbolic m -> m (Symbolic m))
-> AttrSet (Symbolic m) -> HashMap VarName (m (Symbolic m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrSet (Symbolic m)
r)
(m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)])
-> (m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)])
-> Bool
-> m [NTypeF m (Symbolic m)]
-> m [NTypeF m (Symbolic m)]
forall a. a -> a -> Bool -> a
bool
m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
forall a. a -> a
id
((OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (Maybe (AttrSet (Symbolic m)) -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. Maybe (AttrSet r) -> NTypeF m r
TSet (Maybe (AttrSet (Symbolic m)) -> NTypeF m (Symbolic m))
-> Maybe (AttrSet (Symbolic m)) -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ AttrSet (Symbolic m) -> Maybe (AttrSet (Symbolic m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttrSet (Symbolic m)
m) [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a. Semigroup a => a -> a -> a
<>) ([NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> m [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
(Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AttrSet (Symbolic m) -> Bool
forall k v. HashMap k v -> Bool
M.null AttrSet (Symbolic m)
m)
m [NTypeF m (Symbolic m)]
rest
(TClosure{}, TClosure{}) ->
ErrorCall -> m [NTypeF m (Symbolic m)]
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m [NTypeF m (Symbolic m)])
-> ErrorCall -> m [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Cannot unify functions"
(TBuiltin Text
_ Symbolic m -> m (Symbolic m)
_, TBuiltin Text
_ Symbolic m -> m (Symbolic m)
_) ->
ErrorCall -> m [NTypeF m (Symbolic m)]
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m [NTypeF m (Symbolic m)])
-> ErrorCall -> m [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Cannot unify builtin functions"
(NTypeF m (Symbolic m), NTypeF m (Symbolic m))
_ | NTypeF m (Symbolic m) -> NTypeF m (Symbolic m) -> Ordering
forall (m :: * -> *) r. NTypeF m r -> NTypeF m r -> Ordering
compareTypes NTypeF m (Symbolic m)
x NTypeF m (Symbolic m)
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT -> [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
go [NTypeF m (Symbolic m)]
xs [NTypeF m (Symbolic m)]
yys
| NTypeF m (Symbolic m) -> NTypeF m (Symbolic m) -> Ordering
forall (m :: * -> *) r. NTypeF m r -> NTypeF m r -> Ordering
compareTypes NTypeF m (Symbolic m)
x NTypeF m (Symbolic m)
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT -> [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
go [NTypeF m (Symbolic m)]
xxs [NTypeF m (Symbolic m)]
ys
| Bool
otherwise -> Text -> m [NTypeF m (Symbolic m)]
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"impossible"
where
rest :: m [NTypeF m (Symbolic m)]
rest :: m [NTypeF m (Symbolic m)]
rest = [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)] -> m [NTypeF m (Symbolic m)]
go [NTypeF m (Symbolic m)]
xs [NTypeF m (Symbolic m)]
ys
unify
:: forall e m
. MonadLint e m
=> NExprF ()
-> Symbolic m
-> Symbolic m
-> m (Symbolic m)
unify :: NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
unify NExprF ()
context (SV SValue m
x) (SV SValue m
y) = do
NSymbolicF (NTypeF m (Symbolic m))
x' <- SValue m -> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef SValue m
x
NSymbolicF (NTypeF m (Symbolic m))
y' <- SValue m -> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef SValue m
y
case (NSymbolicF (NTypeF m (Symbolic m))
x', NSymbolicF (NTypeF m (Symbolic m))
y') of
(NSymbolicF (NTypeF m (Symbolic m))
NAny, NSymbolicF (NTypeF m (Symbolic m))
_) -> do
SValue m -> NSymbolicF (NTypeF m (Symbolic m)) -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef SValue m
x NSymbolicF (NTypeF m (Symbolic m))
y'
pure $ SValue m -> Symbolic m
forall (m :: * -> *). SValue m -> Symbolic m
SV SValue m
y
(NSymbolicF (NTypeF m (Symbolic m))
_, NSymbolicF (NTypeF m (Symbolic m))
NAny) -> do
SValue m -> NSymbolicF (NTypeF m (Symbolic m)) -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef SValue m
y NSymbolicF (NTypeF m (Symbolic m))
x'
pure $ SValue m -> Symbolic m
forall (m :: * -> *). SValue m -> Symbolic m
SV SValue m
x
(NMany [NTypeF m (Symbolic m)]
xs, NMany [NTypeF m (Symbolic m)]
ys) -> do
[NTypeF m (Symbolic m)]
m <- NExprF ()
-> [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)]
-> m [NTypeF m (Symbolic m)]
forall e (m :: * -> *).
MonadLint e m =>
NExprF ()
-> [NTypeF m (Symbolic m)]
-> [NTypeF m (Symbolic m)]
-> m [NTypeF m (Symbolic m)]
merge NExprF ()
context [NTypeF m (Symbolic m)]
xs [NTypeF m (Symbolic m)]
ys
m (Symbolic m) -> m (Symbolic m) -> Bool -> m (Symbolic m)
forall a. a -> a -> Bool -> a
bool
(do
let
nm :: NSymbolicF (NTypeF m (Symbolic m))
nm = [NTypeF m (Symbolic m)] -> NSymbolicF (NTypeF m (Symbolic m))
forall r. [r] -> NSymbolicF r
NMany [NTypeF m (Symbolic m)]
m
SValue m -> NSymbolicF (NTypeF m (Symbolic m)) -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef SValue m
x NSymbolicF (NTypeF m (Symbolic m))
nm
SValue m -> NSymbolicF (NTypeF m (Symbolic m)) -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef SValue m
y NSymbolicF (NTypeF m (Symbolic m))
nm
NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
NSymbolicF (NTypeF m (Symbolic m)) -> m (Symbolic m)
packSymbolic NSymbolicF (NTypeF m (Symbolic m))
nm
)
(
ErrorCall -> m (Symbolic m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (Symbolic m)) -> ErrorCall -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Cannot unify "
)
([NTypeF m (Symbolic m)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NTypeF m (Symbolic m)]
m)
unify NExprF ()
_ Symbolic m
_ Symbolic m
_ = Text -> m (Symbolic m)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"The unexpected hath transpired!"
instance ToValue Bool m (Symbolic m) where
instance ToValue [Symbolic m] m (Symbolic m) where
instance FromValue NixString m (Symbolic m) where
instance FromValue (AttrSet (Symbolic m), PositionSet) m (Symbolic m) where
instance ToValue (AttrSet (Symbolic m), PositionSet) m (Symbolic m) where
instance (MonadThunkId m, MonadAtomicRef m, MonadCatch m)
=> MonadValue (Symbolic m) m where
defer :: m (Symbolic m) -> m (Symbolic m)
defer :: m (Symbolic m) -> m (Symbolic m)
defer = (SThunk m -> Symbolic m) -> m (SThunk m) -> m (Symbolic m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SThunk m -> Symbolic m
forall (m :: * -> *). SThunk m -> Symbolic m
ST (m (SThunk m) -> m (Symbolic m))
-> (m (Symbolic m) -> m (SThunk m))
-> m (Symbolic m)
-> m (Symbolic m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Symbolic m) -> m (SThunk m)
forall t (m :: * -> *) a. MonadThunk t m a => m a -> m t
thunk
demand :: Symbolic m -> m (Symbolic m)
demand :: Symbolic m -> m (Symbolic m)
demand (ST SThunk m
v) = Symbolic m -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand (Symbolic m -> m (Symbolic m)) -> m (Symbolic m) -> m (Symbolic m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SThunk m -> m (Symbolic m)
forall t (m :: * -> *) a. MonadThunk t m a => t -> m a
force SThunk m
v
demand (SV SValue m
v) = Symbolic m -> m (Symbolic m)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SValue m -> Symbolic m
forall (m :: * -> *). SValue m -> Symbolic m
SV SValue m
v)
instance (MonadThunkId m, MonadAtomicRef m, MonadCatch m)
=> MonadValueF (Symbolic m) m where
demandF :: (Symbolic m -> m r) -> Symbolic m -> m r
demandF :: (Symbolic m -> m r) -> Symbolic m -> m r
demandF Symbolic m -> m r
f (ST SThunk m
v) = (Symbolic m -> m r) -> Symbolic m -> m r
forall v (m :: * -> *) r. MonadValueF v m => (v -> m r) -> v -> m r
demandF Symbolic m -> m r
f (Symbolic m -> m r) -> m (Symbolic m) -> m r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SThunk m -> m (Symbolic m)
forall t (m :: * -> *) a. MonadThunk t m a => t -> m a
force SThunk m
v
demandF Symbolic m -> m r
f (SV SValue m
v) = Symbolic m -> m r
f (SValue m -> Symbolic m
forall (m :: * -> *). SValue m -> Symbolic m
SV SValue m
v)
instance MonadLint e m => MonadEval (Symbolic m) m where
freeVariable :: VarName -> m (Symbolic m)
freeVariable VarName
var = Text -> m (Symbolic m)
forall e (m :: * -> *) a. MonadLint e m => Text -> m a
symerr (Text -> m (Symbolic m)) -> Text -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ Text
"Undefined variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> VarName -> Text
coerce VarName
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
attrMissing :: NonEmpty VarName -> Maybe (Symbolic m) -> m (Symbolic m)
attrMissing NonEmpty VarName
ks Maybe (Symbolic m)
ms =
forall v (m :: * -> *) s a.
(MonadEval v m, Exception s) =>
s -> m a
forall (m :: * -> *) s a.
(MonadEval (Symbolic m) m, Exception s) =>
s -> m a
evalError @(Symbolic m) (ErrorCall -> m (Symbolic m)) -> ErrorCall -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text -> (Symbolic m -> Text) -> Maybe (Symbolic m) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Text
"Inheriting unknown attribute: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attr)
(\ Symbolic m
s -> Text
"Could not look up attribute " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Symbolic m -> Text
forall b a. (Show a, IsString b) => a -> b
show Symbolic m
s)
Maybe (Symbolic m)
ms
where
attr :: Text
attr = Text -> [Text] -> Text
Text.intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty VarName -> NonEmpty Text
coerce NonEmpty VarName
ks
evalCurPos :: m (Symbolic m)
evalCurPos = do
Symbolic m
f <- [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one OneItem [NTypeF m (Symbolic m)]
forall (m :: * -> *) r. NTypeF m r
TPath
Symbolic m
l <- [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TInt
Symbolic m
c <- [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TInt
[NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ Maybe (AttrSet (Symbolic m)) -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. Maybe (AttrSet r) -> NTypeF m r
TSet (AttrSet (Symbolic m) -> Maybe (AttrSet (Symbolic m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(VarName, Symbolic m)] -> AttrSet (Symbolic m)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(VarName
"file", Symbolic m
f), (VarName
"line", Symbolic m
l), (VarName
"col", Symbolic m
c)]))
evalConstant :: NAtom -> m (Symbolic m)
evalConstant NAtom
c = [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ NAtom -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. NAtom -> NTypeF m r
fun NAtom
c
where
fun :: NAtom -> NTypeF m r
fun =
\case
NURI Text
_ -> NTypeF m r
forall (m :: * -> *) r. NTypeF m r
TStr
NInt Integer
_ -> [TAtom] -> NTypeF m r
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m r) -> [TAtom] -> NTypeF m r
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TInt
NFloat Float
_ -> [TAtom] -> NTypeF m r
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m r) -> [TAtom] -> NTypeF m r
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TFloat
NBool Bool
_ -> [TAtom] -> NTypeF m r
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m r) -> [TAtom] -> NTypeF m r
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TBool
NAtom
NNull -> [TAtom] -> NTypeF m r
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m r) -> [TAtom] -> NTypeF m r
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TNull
evalString :: NString (m (Symbolic m)) -> m (Symbolic m)
evalString = m (Symbolic m) -> NString (m (Symbolic m)) -> m (Symbolic m)
forall a b. a -> b -> a
const (m (Symbolic m) -> NString (m (Symbolic m)) -> m (Symbolic m))
-> m (Symbolic m) -> NString (m (Symbolic m)) -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one OneItem [NTypeF m (Symbolic m)]
forall (m :: * -> *) r. NTypeF m r
TStr
evalLiteralPath :: Path -> m (Symbolic m)
evalLiteralPath = m (Symbolic m) -> Path -> m (Symbolic m)
forall a b. a -> b -> a
const (m (Symbolic m) -> Path -> m (Symbolic m))
-> m (Symbolic m) -> Path -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one OneItem [NTypeF m (Symbolic m)]
forall (m :: * -> *) r. NTypeF m r
TPath
evalEnvPath :: Path -> m (Symbolic m)
evalEnvPath = m (Symbolic m) -> Path -> m (Symbolic m)
forall a b. a -> b -> a
const (m (Symbolic m) -> Path -> m (Symbolic m))
-> m (Symbolic m) -> Path -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one OneItem [NTypeF m (Symbolic m)]
forall (m :: * -> *) r. NTypeF m r
TPath
evalUnary :: NUnaryOp -> Symbolic m -> m (Symbolic m)
evalUnary NUnaryOp
op Symbolic m
arg =
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
unify (NExprF (Symbolic m) -> NExprF ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (NExprF (Symbolic m) -> NExprF ())
-> NExprF (Symbolic m) -> NExprF ()
forall a b. (a -> b) -> a -> b
$ NUnaryOp -> Symbolic m -> NExprF (Symbolic m)
forall r. NUnaryOp -> r -> NExprF r
NUnary NUnaryOp
op Symbolic m
arg) Symbolic m
arg (Symbolic m -> m (Symbolic m)) -> m (Symbolic m) -> m (Symbolic m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant [TAtom
TInt, TAtom
TBool])
evalBinary :: NBinaryOp -> Symbolic m -> m (Symbolic m) -> m (Symbolic m)
evalBinary = NBinaryOp -> Symbolic m -> m (Symbolic m) -> m (Symbolic m)
forall e (m :: * -> *).
(MonadLint e m, MonadEval (Symbolic m) m) =>
NBinaryOp -> Symbolic m -> m (Symbolic m) -> m (Symbolic m)
lintBinaryOp
evalWith :: m (Symbolic m) -> m (Symbolic m) -> m (Symbolic m)
evalWith m (Symbolic m)
scope m (Symbolic m)
body =
do
NSymbolicF (NTypeF m (Symbolic m))
s <- Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *).
(MonadAtomicRef m, MonadThunkId m, MonadCatch m) =>
Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
unpackSymbolic (Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m))))
-> m (Symbolic m) -> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Symbolic m -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => v -> m v
demand (Symbolic m -> m (Symbolic m)) -> m (Symbolic m) -> m (Symbolic m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Symbolic m) -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer m (Symbolic m)
scope
m (Scope (Symbolic m)) -> m (Symbolic m) -> m (Symbolic m)
forall (m :: * -> *) a r.
(Functor m, Scoped a m) =>
m (Scope a) -> m r -> m r
pushWeakScope
(case NSymbolicF (NTypeF m (Symbolic m))
s of
NMany [TSet (Just (AttrSet (Symbolic m) -> Scope (Symbolic m)
coerce -> Scope (Symbolic m)
scope))] -> Scope (Symbolic m) -> m (Scope (Symbolic m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scope (Symbolic m)
scope
NMany [TSet Maybe (AttrSet (Symbolic m))
Nothing] -> Text -> m (Scope (Symbolic m))
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"NYI: with unknown"
NSymbolicF (NTypeF m (Symbolic m))
_ -> ErrorCall -> m (Scope (Symbolic m))
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (Scope (Symbolic m)))
-> ErrorCall -> m (Scope (Symbolic m))
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"scope must be a set in with statement"
)
m (Symbolic m)
body
evalIf :: Symbolic m -> m (Symbolic m) -> m (Symbolic m) -> m (Symbolic m)
evalIf Symbolic m
cond m (Symbolic m)
t m (Symbolic m)
f =
do
Symbolic m
t' <- m (Symbolic m)
t
Symbolic m
f' <- m (Symbolic m)
f
let e :: NExprF (Symbolic m)
e = Symbolic m -> Symbolic m -> Symbolic m -> NExprF (Symbolic m)
forall r. r -> r -> r -> NExprF r
NIf Symbolic m
cond Symbolic m
t' Symbolic m
f'
Symbolic m
_ <- NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
unify (NExprF (Symbolic m) -> NExprF ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void NExprF (Symbolic m)
e) Symbolic m
cond (Symbolic m -> m (Symbolic m)) -> m (Symbolic m) -> m (Symbolic m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TBool)
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
unify (NExprF (Symbolic m) -> NExprF ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void NExprF (Symbolic m)
e) Symbolic m
t' Symbolic m
f'
evalAssert :: Symbolic m -> m (Symbolic m) -> m (Symbolic m)
evalAssert Symbolic m
cond m (Symbolic m)
body =
do
Symbolic m
body' <- m (Symbolic m)
body
let e :: NExprF (Symbolic m)
e = Symbolic m -> Symbolic m -> NExprF (Symbolic m)
forall r. r -> r -> NExprF r
NAssert Symbolic m
cond Symbolic m
body'
Symbolic m
_ <- NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
unify (NExprF (Symbolic m) -> NExprF ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void NExprF (Symbolic m)
e) Symbolic m
cond (Symbolic m -> m (Symbolic m)) -> m (Symbolic m) -> m (Symbolic m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TBool)
pure Symbolic m
body'
evalApp :: Symbolic m -> m (Symbolic m) -> m (Symbolic m)
evalApp = (((AttrSet (Symbolic m), Symbolic m) -> Symbolic m)
-> m (AttrSet (Symbolic m), Symbolic m) -> m (Symbolic m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AttrSet (Symbolic m), Symbolic m) -> Symbolic m
forall a b. (a, b) -> b
snd (m (AttrSet (Symbolic m), Symbolic m) -> m (Symbolic m))
-> (m (Symbolic m) -> m (AttrSet (Symbolic m), Symbolic m))
-> m (Symbolic m)
-> m (Symbolic m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((m (Symbolic m) -> m (AttrSet (Symbolic m), Symbolic m))
-> m (Symbolic m) -> m (Symbolic m))
-> (Symbolic m
-> m (Symbolic m) -> m (AttrSet (Symbolic m), Symbolic m))
-> Symbolic m
-> m (Symbolic m)
-> m (Symbolic m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprF ()
-> Symbolic m
-> m (Symbolic m)
-> m (AttrSet (Symbolic m), Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF ()
-> Symbolic m
-> m (Symbolic m)
-> m (HashMap VarName (Symbolic m), Symbolic m)
lintApp ((() -> () -> NExprF ()) -> () -> NExprF ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (NBinaryOp -> () -> () -> NExprF ()
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp) ()
forall a. Monoid a => a
mempty)
evalAbs :: Params (m (Symbolic m))
-> (forall a.
m (Symbolic m)
-> (AttrSet (m (Symbolic m))
-> m (Symbolic m) -> m (a, Symbolic m))
-> m (a, Symbolic m))
-> m (Symbolic m)
evalAbs Params (m (Symbolic m))
params forall a.
m (Symbolic m)
-> (AttrSet (m (Symbolic m))
-> m (Symbolic m) -> m (a, Symbolic m))
-> m (a, Symbolic m)
_ = [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ Params () -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. Params () -> NTypeF m r
TClosure (Params () -> NTypeF m (Symbolic m))
-> Params () -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ Params (m (Symbolic m)) -> Params ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Params (m (Symbolic m))
params)
evalError :: s -> m a
evalError = s -> m a
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError
lintBinaryOp
:: forall e m
. (MonadLint e m, MonadEval (Symbolic m) m)
=> NBinaryOp
-> Symbolic m
-> m (Symbolic m)
-> m (Symbolic m)
lintBinaryOp :: NBinaryOp -> Symbolic m -> m (Symbolic m) -> m (Symbolic m)
lintBinaryOp NBinaryOp
op Symbolic m
lsym m (Symbolic m)
rarg =
do
Symbolic m
rsym <- m (Symbolic m)
rarg
Symbolic m
y <- m (Symbolic m) -> m (Symbolic m)
forall v (m :: * -> *). MonadValue v m => m v -> m v
defer m (Symbolic m)
forall (m :: * -> *). MonadAtomicRef m => m (Symbolic m)
everyPossible
case NBinaryOp
op of
NBinaryOp
NApp -> Text -> m (Symbolic m)
forall e (m :: * -> *) a. MonadLint e m => Text -> m a
symerr Text
"lintBinaryOp:NApp: should never get here"
NBinaryOp
_ -> Symbolic m
-> Symbolic m -> [NTypeF m (Symbolic m)] -> m (Symbolic m)
check Symbolic m
lsym Symbolic m
rsym ([NTypeF m (Symbolic m)] -> m (Symbolic m))
-> [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall a b. (a -> b) -> a -> b
$
case NBinaryOp
op of
NBinaryOp
NEq -> [[TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant [TAtom
TInt, TAtom
TBool, TAtom
TNull], NTypeF m (Symbolic m)
forall (m :: * -> *) r. NTypeF m r
TStr, Symbolic m -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. r -> NTypeF m r
TList Symbolic m
y]
NBinaryOp
NNEq -> [[TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant [TAtom
TInt, TAtom
TBool, TAtom
TNull], NTypeF m (Symbolic m)
forall (m :: * -> *) r. NTypeF m r
TStr, Symbolic m -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. r -> NTypeF m r
TList Symbolic m
y]
NBinaryOp
NLt -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant [TAtom
TInt, TAtom
TBool, TAtom
TNull]
NBinaryOp
NLte -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant [TAtom
TInt, TAtom
TBool, TAtom
TNull]
NBinaryOp
NGt -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant [TAtom
TInt, TAtom
TBool, TAtom
TNull]
NBinaryOp
NGte -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant [TAtom
TInt, TAtom
TBool, TAtom
TNull]
NBinaryOp
NAnd -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TBool
NBinaryOp
NOr -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TBool
NBinaryOp
NImpl -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TBool
NBinaryOp
NPlus -> [[TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TInt, NTypeF m (Symbolic m)
forall (m :: * -> *) r. NTypeF m r
TStr, NTypeF m (Symbolic m)
forall (m :: * -> *) r. NTypeF m r
TPath]
NBinaryOp
NMinus -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TInt
NBinaryOp
NMult -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TInt
NBinaryOp
NDiv -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ [TAtom] -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. [TAtom] -> NTypeF m r
TConstant ([TAtom] -> NTypeF m (Symbolic m))
-> [TAtom] -> NTypeF m (Symbolic m)
forall a b. (a -> b) -> a -> b
$ OneItem [TAtom] -> [TAtom]
forall x. One x => OneItem x -> x
one OneItem [TAtom]
TAtom
TInt
NBinaryOp
NUpdate -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ Maybe (AttrSet (Symbolic m)) -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. Maybe (AttrSet r) -> NTypeF m r
TSet Maybe (AttrSet (Symbolic m))
forall a. Monoid a => a
mempty
NBinaryOp
NConcat -> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall x. One x => OneItem x -> x
one (OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)])
-> OneItem [NTypeF m (Symbolic m)] -> [NTypeF m (Symbolic m)]
forall a b. (a -> b) -> a -> b
$ Symbolic m -> NTypeF m (Symbolic m)
forall (m :: * -> *) r. r -> NTypeF m r
TList Symbolic m
y
#if __GLASGOW_HASKELL__ < 900
NBinaryOp
_ -> String -> [NTypeF m (Symbolic m)]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Should not be possible"
#endif
where
check :: Symbolic m
-> Symbolic m -> [NTypeF m (Symbolic m)] -> m (Symbolic m)
check Symbolic m
lsym Symbolic m
rsym [NTypeF m (Symbolic m)]
xs =
do
let
e :: NExprF (Symbolic m)
e = NBinaryOp -> Symbolic m -> Symbolic m -> NExprF (Symbolic m)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
op Symbolic m
lsym Symbolic m
rsym
unifyE :: Symbolic m -> Symbolic m -> m (Symbolic m)
unifyE = NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
unify (NExprF (Symbolic m) -> NExprF ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void NExprF (Symbolic m)
e)
Symbolic m
m <- [NTypeF m (Symbolic m)] -> m (Symbolic m)
forall (m :: * -> *).
MonadAtomicRef m =>
[NTypeF m (Symbolic m)] -> m (Symbolic m)
mkSymbolic [NTypeF m (Symbolic m)]
xs
Symbolic m
_ <- Symbolic m -> Symbolic m -> m (Symbolic m)
unifyE Symbolic m
lsym Symbolic m
m
Symbolic m
_ <- Symbolic m -> Symbolic m -> m (Symbolic m)
unifyE Symbolic m
rsym Symbolic m
m
Symbolic m -> Symbolic m -> m (Symbolic m)
unifyE Symbolic m
lsym Symbolic m
rsym
infixl 1 `lintApp`
lintApp
:: forall e m
. MonadLint e m
=> NExprF ()
-> Symbolic m
-> m (Symbolic m)
-> m (HashMap VarName (Symbolic m), Symbolic m)
lintApp :: NExprF ()
-> Symbolic m
-> m (Symbolic m)
-> m (HashMap VarName (Symbolic m), Symbolic m)
lintApp NExprF ()
context Symbolic m
fun m (Symbolic m)
arg =
(\case
NSymbolicF (NTypeF m (Symbolic m))
NAny ->
ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m))
-> ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Cannot apply something not known to be a function"
NMany [NTypeF m (Symbolic m)]
xs -> do
([HashMap VarName (Symbolic m)]
args, [Symbolic m]
ys) <- ([(HashMap VarName (Symbolic m), Symbolic m)]
-> ([HashMap VarName (Symbolic m)], [Symbolic m]))
-> m [(HashMap VarName (Symbolic m), Symbolic m)]
-> m ([HashMap VarName (Symbolic m)], [Symbolic m])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(HashMap VarName (Symbolic m), Symbolic m)]
-> ([HashMap VarName (Symbolic m)], [Symbolic m])
forall a b. [(a, b)] -> ([a], [b])
unzip (m [(HashMap VarName (Symbolic m), Symbolic m)]
-> m ([HashMap VarName (Symbolic m)], [Symbolic m]))
-> m [(HashMap VarName (Symbolic m), Symbolic m)]
-> m ([HashMap VarName (Symbolic m)], [Symbolic m])
forall a b. (a -> b) -> a -> b
$ [NTypeF m (Symbolic m)]
-> (NTypeF m (Symbolic m)
-> m (HashMap VarName (Symbolic m), Symbolic m))
-> m [(HashMap VarName (Symbolic m), Symbolic m)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [NTypeF m (Symbolic m)]
xs ((NTypeF m (Symbolic m)
-> m (HashMap VarName (Symbolic m), Symbolic m))
-> m [(HashMap VarName (Symbolic m), Symbolic m)])
-> (NTypeF m (Symbolic m)
-> m (HashMap VarName (Symbolic m), Symbolic m))
-> m [(HashMap VarName (Symbolic m), Symbolic m)]
forall a b. (a -> b) -> a -> b
$ \case
TClosure Params ()
_params ->
(\case
NSymbolicF (NTypeF m (Symbolic m))
NAny -> do
Text -> m (HashMap VarName (Symbolic m), Symbolic m)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"NYI"
NMany [TSet (Just HashMap VarName (Symbolic m)
_)] -> do
Text -> m (HashMap VarName (Symbolic m), Symbolic m)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"NYI"
NMany [NTypeF m (Symbolic m)]
_ -> ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m))
-> ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"NYI: lintApp NMany not set"
) (NSymbolicF (NTypeF m (Symbolic m))
-> m (HashMap VarName (Symbolic m), Symbolic m))
-> m (NSymbolicF (NTypeF m (Symbolic m)))
-> m (HashMap VarName (Symbolic m), Symbolic m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *).
(MonadAtomicRef m, MonadThunkId m, MonadCatch m) =>
Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
unpackSymbolic (Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m))))
-> m (Symbolic m) -> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Symbolic m)
arg
TBuiltin Text
_ Symbolic m -> m (Symbolic m)
_f -> ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m))
-> ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"NYI: lintApp builtin"
TSet Maybe (HashMap VarName (Symbolic m))
_m -> ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m))
-> ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"NYI: lintApp Set"
NTypeF m (Symbolic m)
_x -> ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m))
-> ErrorCall -> m (HashMap VarName (Symbolic m), Symbolic m)
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Attempt to call non-function"
Symbolic m
y <- m (Symbolic m)
forall (m :: * -> *). MonadAtomicRef m => m (Symbolic m)
everyPossible
([HashMap VarName (Symbolic m)] -> HashMap VarName (Symbolic m)
forall a. [a] -> a
Unsafe.head [HashMap VarName (Symbolic m)]
args, ) (Symbolic m -> (HashMap VarName (Symbolic m), Symbolic m))
-> m (Symbolic m) -> m (HashMap VarName (Symbolic m), Symbolic m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Symbolic m -> Symbolic m -> m (Symbolic m))
-> Symbolic m -> [Symbolic m] -> m (Symbolic m)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
forall e (m :: * -> *).
MonadLint e m =>
NExprF () -> Symbolic m -> Symbolic m -> m (Symbolic m)
unify NExprF ()
context) Symbolic m
y [Symbolic m]
ys
) (NSymbolicF (NTypeF m (Symbolic m))
-> m (HashMap VarName (Symbolic m), Symbolic m))
-> m (NSymbolicF (NTypeF m (Symbolic m)))
-> m (HashMap VarName (Symbolic m), Symbolic m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
forall (m :: * -> *).
(MonadAtomicRef m, MonadThunkId m, MonadCatch m) =>
Symbolic m -> m (NSymbolicF (NTypeF m (Symbolic m)))
unpackSymbolic Symbolic m
fun
newtype Lint s a = Lint
{ Lint s a
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
runLint :: ReaderT (Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a }
deriving
( a -> Lint s b -> Lint s a
(a -> b) -> Lint s a -> Lint s b
(forall a b. (a -> b) -> Lint s a -> Lint s b)
-> (forall a b. a -> Lint s b -> Lint s a) -> Functor (Lint s)
forall a b. a -> Lint s b -> Lint s a
forall a b. (a -> b) -> Lint s a -> Lint s b
forall s a b. a -> Lint s b -> Lint s a
forall s a b. (a -> b) -> Lint s a -> Lint s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Lint s b -> Lint s a
$c<$ :: forall s a b. a -> Lint s b -> Lint s a
fmap :: (a -> b) -> Lint s a -> Lint s b
$cfmap :: forall s a b. (a -> b) -> Lint s a -> Lint s b
Functor
, Functor (Lint s)
a -> Lint s a
Functor (Lint s)
-> (forall a. a -> Lint s a)
-> (forall a b. Lint s (a -> b) -> Lint s a -> Lint s b)
-> (forall a b c.
(a -> b -> c) -> Lint s a -> Lint s b -> Lint s c)
-> (forall a b. Lint s a -> Lint s b -> Lint s b)
-> (forall a b. Lint s a -> Lint s b -> Lint s a)
-> Applicative (Lint s)
Lint s a -> Lint s b -> Lint s b
Lint s a -> Lint s b -> Lint s a
Lint s (a -> b) -> Lint s a -> Lint s b
(a -> b -> c) -> Lint s a -> Lint s b -> Lint s c
forall s. Functor (Lint s)
forall a. a -> Lint s a
forall s a. a -> Lint s a
forall a b. Lint s a -> Lint s b -> Lint s a
forall a b. Lint s a -> Lint s b -> Lint s b
forall a b. Lint s (a -> b) -> Lint s a -> Lint s b
forall s a b. Lint s a -> Lint s b -> Lint s a
forall s a b. Lint s a -> Lint s b -> Lint s b
forall s a b. Lint s (a -> b) -> Lint s a -> Lint s b
forall a b c. (a -> b -> c) -> Lint s a -> Lint s b -> Lint s c
forall s a b c. (a -> b -> c) -> Lint s a -> Lint s b -> Lint s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Lint s a -> Lint s b -> Lint s a
$c<* :: forall s a b. Lint s a -> Lint s b -> Lint s a
*> :: Lint s a -> Lint s b -> Lint s b
$c*> :: forall s a b. Lint s a -> Lint s b -> Lint s b
liftA2 :: (a -> b -> c) -> Lint s a -> Lint s b -> Lint s c
$cliftA2 :: forall s a b c. (a -> b -> c) -> Lint s a -> Lint s b -> Lint s c
<*> :: Lint s (a -> b) -> Lint s a -> Lint s b
$c<*> :: forall s a b. Lint s (a -> b) -> Lint s a -> Lint s b
pure :: a -> Lint s a
$cpure :: forall s a. a -> Lint s a
$cp1Applicative :: forall s. Functor (Lint s)
Applicative
, Applicative (Lint s)
a -> Lint s a
Applicative (Lint s)
-> (forall a b. Lint s a -> (a -> Lint s b) -> Lint s b)
-> (forall a b. Lint s a -> Lint s b -> Lint s b)
-> (forall a. a -> Lint s a)
-> Monad (Lint s)
Lint s a -> (a -> Lint s b) -> Lint s b
Lint s a -> Lint s b -> Lint s b
forall s. Applicative (Lint s)
forall a. a -> Lint s a
forall s a. a -> Lint s a
forall a b. Lint s a -> Lint s b -> Lint s b
forall a b. Lint s a -> (a -> Lint s b) -> Lint s b
forall s a b. Lint s a -> Lint s b -> Lint s b
forall s a b. Lint s a -> (a -> Lint s b) -> Lint s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Lint s a
$creturn :: forall s a. a -> Lint s a
>> :: Lint s a -> Lint s b -> Lint s b
$c>> :: forall s a b. Lint s a -> Lint s b -> Lint s b
>>= :: Lint s a -> (a -> Lint s b) -> Lint s b
$c>>= :: forall s a b. Lint s a -> (a -> Lint s b) -> Lint s b
$cp1Monad :: forall s. Applicative (Lint s)
Monad
, Monad (Lint s)
Monad (Lint s)
-> (forall a. (a -> Lint s a) -> Lint s a) -> MonadFix (Lint s)
(a -> Lint s a) -> Lint s a
forall s. Monad (Lint s)
forall a. (a -> Lint s a) -> Lint s a
forall s a. (a -> Lint s a) -> Lint s a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> Lint s a) -> Lint s a
$cmfix :: forall s a. (a -> Lint s a) -> Lint s a
$cp1MonadFix :: forall s. Monad (Lint s)
MonadFix
, MonadReader (Context (Lint s) (Symbolic (Lint s)))
, Eq (ThunkId (Lint s))
Monad (Lint s)
Ord (ThunkId (Lint s))
Show (ThunkId (Lint s))
Typeable (ThunkId (Lint s))
Lint s (ThunkId (Lint s))
Monad (Lint s)
-> Eq (ThunkId (Lint s))
-> Ord (ThunkId (Lint s))
-> Show (ThunkId (Lint s))
-> Typeable (ThunkId (Lint s))
-> Lint s (ThunkId (Lint s))
-> MonadThunkId (Lint s)
forall s. Eq (ThunkId (Lint s))
forall s. Monad (Lint s)
forall s. Ord (ThunkId (Lint s))
forall s. Show (ThunkId (Lint s))
forall s. Typeable (ThunkId (Lint s))
forall s. Lint s (ThunkId (Lint s))
forall (m :: * -> *).
Monad m
-> Eq (ThunkId m)
-> Ord (ThunkId m)
-> Show (ThunkId m)
-> Typeable (ThunkId m)
-> m (ThunkId m)
-> MonadThunkId m
freshId :: Lint s (ThunkId (Lint s))
$cfreshId :: forall s. Lint s (ThunkId (Lint s))
$cp5MonadThunkId :: forall s. Typeable (ThunkId (Lint s))
$cp4MonadThunkId :: forall s. Show (ThunkId (Lint s))
$cp3MonadThunkId :: forall s. Ord (ThunkId (Lint s))
$cp2MonadThunkId :: forall s. Eq (ThunkId (Lint s))
$cp1MonadThunkId :: forall s. Monad (Lint s)
MonadThunkId
, Monad (Lint s)
a -> Lint s (Ref (Lint s) a)
Monad (Lint s)
-> (forall a. a -> Lint s (Ref (Lint s) a))
-> (forall a. Ref (Lint s) a -> Lint s a)
-> (forall a. Ref (Lint s) a -> a -> Lint s ())
-> (forall a. Ref (Lint s) a -> (a -> a) -> Lint s ())
-> (forall a. Ref (Lint s) a -> (a -> a) -> Lint s ())
-> MonadRef (Lint s)
Ref (Lint s) a -> Lint s a
Ref (Lint s) a -> a -> Lint s ()
Ref (Lint s) a -> (a -> a) -> Lint s ()
Ref (Lint s) a -> (a -> a) -> Lint s ()
forall s. Monad (Lint s)
forall a. a -> Lint s (Ref (Lint s) a)
forall a. Ref (Lint s) a -> Lint s a
forall a. Ref (Lint s) a -> a -> Lint s ()
forall a. Ref (Lint s) a -> (a -> a) -> Lint s ()
forall s a. a -> Lint s (Ref (Lint s) a)
forall s a. Ref (Lint s) a -> Lint s a
forall s a. Ref (Lint s) a -> a -> Lint s ()
forall s a. Ref (Lint s) a -> (a -> a) -> Lint s ()
forall (m :: * -> *).
Monad m
-> (forall a. a -> m (Ref m a))
-> (forall a. Ref m a -> m a)
-> (forall a. Ref m a -> a -> m ())
-> (forall a. Ref m a -> (a -> a) -> m ())
-> (forall a. Ref m a -> (a -> a) -> m ())
-> MonadRef m
modifyRef' :: Ref (Lint s) a -> (a -> a) -> Lint s ()
$cmodifyRef' :: forall s a. Ref (Lint s) a -> (a -> a) -> Lint s ()
modifyRef :: Ref (Lint s) a -> (a -> a) -> Lint s ()
$cmodifyRef :: forall s a. Ref (Lint s) a -> (a -> a) -> Lint s ()
writeRef :: Ref (Lint s) a -> a -> Lint s ()
$cwriteRef :: forall s a. Ref (Lint s) a -> a -> Lint s ()
readRef :: Ref (Lint s) a -> Lint s a
$creadRef :: forall s a. Ref (Lint s) a -> Lint s a
newRef :: a -> Lint s (Ref (Lint s) a)
$cnewRef :: forall s a. a -> Lint s (Ref (Lint s) a)
$cp1MonadRef :: forall s. Monad (Lint s)
MonadRef
, MonadRef (Lint s)
Ref (Lint s) a -> (a -> (a, b)) -> Lint s b
Ref (Lint s) a -> (a -> (a, b)) -> Lint s b
MonadRef (Lint s)
-> (forall a b. Ref (Lint s) a -> (a -> (a, b)) -> Lint s b)
-> (forall a b. Ref (Lint s) a -> (a -> (a, b)) -> Lint s b)
-> MonadAtomicRef (Lint s)
forall s. MonadRef (Lint s)
forall a b. Ref (Lint s) a -> (a -> (a, b)) -> Lint s b
forall s a b. Ref (Lint s) a -> (a -> (a, b)) -> Lint s b
forall (m :: * -> *).
MonadRef m
-> (forall a b. Ref m a -> (a -> (a, b)) -> m b)
-> (forall a b. Ref m a -> (a -> (a, b)) -> m b)
-> MonadAtomicRef m
atomicModifyRef' :: Ref (Lint s) a -> (a -> (a, b)) -> Lint s b
$catomicModifyRef' :: forall s a b. Ref (Lint s) a -> (a -> (a, b)) -> Lint s b
atomicModifyRef :: Ref (Lint s) a -> (a -> (a, b)) -> Lint s b
$catomicModifyRef :: forall s a b. Ref (Lint s) a -> (a -> (a, b)) -> Lint s b
$cp1MonadAtomicRef :: forall s. MonadRef (Lint s)
MonadAtomicRef
)
instance MonadThrow (Lint s) where
throwM :: forall e a . Exception e => e -> Lint s a
throwM :: e -> Lint s a
throwM e
e = ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> Lint s a
forall s a.
ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> Lint s a
Lint (ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> Lint s a)
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> Lint s a
forall a b. (a -> b) -> a -> b
$ (Context (Lint s) (Symbolic (Lint s)) -> FreshIdT Int (ST s) a)
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Context (Lint s) (Symbolic (Lint s)) -> FreshIdT Int (ST s) a)
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a)
-> (Context (Lint s) (Symbolic (Lint s)) -> FreshIdT Int (ST s) a)
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
forall a b. (a -> b) -> a -> b
$ FreshIdT Int (ST s) a
-> Context (Lint s) (Symbolic (Lint s)) -> FreshIdT Int (ST s) a
forall a b. a -> b -> a
const (e -> FreshIdT Int (ST s) a
forall a e. Exception e => e -> a
throw e
e)
instance MonadCatch (Lint s) where
catch :: Lint s a -> (e -> Lint s a) -> Lint s a
catch Lint s a
_m e -> Lint s a
_h = ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> Lint s a
forall s a.
ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> Lint s a
Lint (ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> Lint s a)
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> Lint s a
forall a b. (a -> b) -> a -> b
$ (Context (Lint s) (Symbolic (Lint s)) -> FreshIdT Int (ST s) a)
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Context (Lint s) (Symbolic (Lint s)) -> FreshIdT Int (ST s) a)
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a)
-> (Context (Lint s) (Symbolic (Lint s)) -> FreshIdT Int (ST s) a)
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
forall a b. (a -> b) -> a -> b
$ FreshIdT Int (ST s) a
-> Context (Lint s) (Symbolic (Lint s)) -> FreshIdT Int (ST s) a
forall a b. a -> b -> a
const (String -> FreshIdT Int (ST s) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot catch in 'Lint s'")
runLintM :: Options -> Lint s a -> ST s a
runLintM :: Options -> Lint s a -> ST s a
runLintM Options
opts Lint s a
action =
FreshIdT Int (ST s) a -> Ref (ST s) Int -> ST s a
forall (m :: * -> *) i a.
Functor m =>
FreshIdT i m a -> Ref m i -> m a
runFreshIdT ((ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> Context (Lint s) (Symbolic (Lint s)) -> FreshIdT Int (ST s) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Options -> Context (Lint s) (Symbolic (Lint s))
forall (m :: * -> *) t. Options -> Context m t
newContext Options
opts) (ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> FreshIdT Int (ST s) a)
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
-> FreshIdT Int (ST s) a
forall a b. (a -> b) -> a -> b
$ Lint s a
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
forall s a.
Lint s a
-> ReaderT
(Context (Lint s) (Symbolic (Lint s))) (FreshIdT Int (ST s)) a
runLint Lint s a
action) (STRef s Int -> ST s a) -> ST s (STRef s Int) -> ST s a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> ST s (Ref (ST s) Int)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef (Int
1 :: Int)
symbolicBaseEnv
:: Monad m
=> m (Scopes m (Symbolic m))
symbolicBaseEnv :: m (Scopes m (Symbolic m))
symbolicBaseEnv = m (Scopes m (Symbolic m))
forall (f :: * -> *) a. (Applicative f, Monoid a) => f a
stub
lint :: Options -> NExprLoc -> ST s (Symbolic (Lint s))
lint :: Options -> NExprLoc -> ST s (Symbolic (Lint s))
lint Options
opts NExprLoc
expr =
Options -> Lint s (Symbolic (Lint s)) -> ST s (Symbolic (Lint s))
forall s a. Options -> Lint s a -> ST s a
runLintM Options
opts (Lint s (Symbolic (Lint s)) -> ST s (Symbolic (Lint s)))
-> Lint s (Symbolic (Lint s)) -> ST s (Symbolic (Lint s))
forall a b. (a -> b) -> a -> b
$
do
Scopes (Lint s) (Symbolic (Lint s))
basis <- Lint s (Scopes (Lint s) (Symbolic (Lint s)))
forall (m :: * -> *). Monad m => m (Scopes m (Symbolic m))
symbolicBaseEnv
Scopes (Lint s) (Symbolic (Lint s))
-> Lint s (Symbolic (Lint s)) -> Lint s (Symbolic (Lint s))
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
pushScopes
Scopes (Lint s) (Symbolic (Lint s))
basis
(Transform NExprLocF (Lint s (Symbolic (Lint s)))
-> Alg NExprLocF (Lint s (Symbolic (Lint s)))
-> NExprLoc
-> Lint s (Symbolic (Lint s))
forall (f :: * -> *) a.
Functor f =>
Transform f a -> Alg f a -> Fix f -> a
adi
Transform NExprLocF (Lint s (Symbolic (Lint s)))
forall e (m :: * -> *) a.
(MonadReader e m, Has e SrcSpan) =>
Transform NExprLocF (m a)
Eval.addSourcePositions
Alg NExprLocF (Lint s (Symbolic (Lint s)))
forall v (m :: * -> *) ann.
MonadNixEval v m =>
AnnF ann NExprF (m v) -> m v
Eval.evalContent
NExprLoc
expr
)
instance
Scoped (Symbolic (Lint s)) (Lint s) where
askScopes :: Lint s (Scopes (Lint s) (Symbolic (Lint s)))
askScopes = Lint s (Scopes (Lint s) (Symbolic (Lint s)))
forall (m :: * -> *) a e.
(MonadReader e m, Has e (Scopes m a)) =>
m (Scopes m a)
askScopesReader
clearScopes :: Lint s r -> Lint s r
clearScopes = forall e r.
(MonadReader e (Lint s),
Has e (Scopes (Lint s) (Symbolic (Lint s)))) =>
Lint s r -> Lint s r
forall (m :: * -> *) a e r.
(MonadReader e m, Has e (Scopes m a)) =>
m r -> m r
clearScopesReader @(Lint s) @(Symbolic (Lint s))
pushScopes :: Scopes (Lint s) (Symbolic (Lint s)) -> Lint s r -> Lint s r
pushScopes = Scopes (Lint s) (Symbolic (Lint s)) -> Lint s r -> Lint s r
forall e (m :: * -> *) a r.
(MonadReader e m, Has e (Scopes m a)) =>
Scopes m a -> m r -> m r
pushScopesReader
lookupVar :: VarName -> Lint s (Maybe (Symbolic (Lint s)))
lookupVar = VarName -> Lint s (Maybe (Symbolic (Lint s)))
forall (m :: * -> *) a e.
(MonadReader e m, Has e (Scopes m a)) =>
VarName -> m (Maybe a)
lookupVarReader