1
1
mirror of https://github.com/github/semantic.git synced 2024-12-29 01:42:43 +03:00

🔥 Located.

This commit is contained in:
Rob Rix 2018-12-13 12:04:24 -05:00
parent 595f0fa2a3
commit 594979543c
2 changed files with 0 additions and 49 deletions

View File

@ -53,7 +53,6 @@ library
, Control.Rewriting
-- Datatypes for abstract interpretation
, Data.Abstract.Address.Hole
, Data.Abstract.Address.Located
, Data.Abstract.Address.Monovariant
, Data.Abstract.Address.Precise
, Data.Abstract.BaseError

View File

@ -1,48 +0,0 @@
{-# LANGUAGE LambdaCase, TypeOperators, UndecidableInstances #-}
module Data.Abstract.Address.Located
( Located(..)
) where
import Control.Abstract
import Control.Effect.Carrier
import Control.Effect.Sum
import Data.Abstract.Module (ModuleInfo)
import Data.Abstract.Name
import Data.Abstract.Package (PackageInfo)
data Located address = Located
{ address :: address
, addressPackage :: {-# UNPACK #-} !PackageInfo
, addressModule :: !ModuleInfo
, addressName :: Name
, addressSpan :: Span
}
deriving (Eq, Ord, Show)
promoteA :: AllocatorC address m a -> AllocatorC (Located address) m a
promoteA = AllocatorC . runAllocatorC
instance ( Carrier (Allocator address :+: sig) (AllocatorC address m)
, Carrier sig m
, Member (Reader ModuleInfo) sig
, Member (Reader PackageInfo) sig
, Member (Reader Span) sig
, Monad m
)
=> Carrier (Allocator (Located address) :+: sig) (AllocatorC (Located address) m) where
ret = promoteA . ret
eff = handleSum
(AllocatorC . eff . handleCoercible)
(\ (Alloc name k) -> Located <$> promoteA (eff (L (Alloc name ret))) <*> currentPackage <*> currentModule <*> pure name <*> ask >>= k)
promoteD :: DerefC address value m a -> DerefC (Located address) value m a
promoteD = DerefC . runDerefC
instance (Carrier (Deref value :+: sig) (DerefC address value m), Carrier sig m, Monad m)
=> Carrier (Deref value :+: sig) (DerefC (Located address) value m) where
ret = promoteD . ret
eff = handleSum (DerefC . eff . handleCoercible) (\case
DerefCell cell k -> promoteD (eff (L (DerefCell cell ret))) >>= k
AssignCell value cell k -> promoteD (eff (L (AssignCell value cell ret))) >>= k)