github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-01 19:55:34 +03:00
Code Issues Projects Releases Wiki Activity

🔥 the demotes.

Browse Source
This commit is contained in:
Rob Rix 2018-10-23 15:50:42 -04:00
parent a18410cb0b
commit 88a116cedc
2 changed files with 6 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Data/Abstract/Address/Hole.hs
View File

@ -20,20 +20,9 @@ toMaybe (Partial _) = Nothing
toMaybe (Total a) = Just a
demoteD :: DerefC (Hole context address) value m a -> DerefC address value m a
demoteD = DerefC . runDerefC
promoteD :: DerefC address value m a -> DerefC (Hole context address) value m a
promoteD = DerefC . runDerefC
demoteA :: AllocatorC (Hole context address) m a -> AllocatorC address m a
demoteA = AllocatorC . runAllocatorC
promoteA :: AllocatorC address m a -> AllocatorC (Hole context address) m a
promoteA = AllocatorC . runAllocatorC
instance ( Carrier (Allocator address :+: sig) (AllocatorC address m)
, Carrier sig m
, Monad m
@ -44,6 +33,9 @@ instance ( Carrier (Allocator address :+: sig) (AllocatorC address m)
where alg (Alloc name k) = Total <$> promoteA (eff (L (Alloc name ret))) >>= k
promoteD :: DerefC address value m a -> DerefC (Hole context 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 (Hole context address) value m) where
ret = promoteD . ret

14
src/Data/Abstract/Address/Located.hs
View File

@ -20,20 +20,9 @@ data Located address = Located
deriving (Eq, Ord, Show)
demoteD :: DerefC (Located address) value m a -> DerefC address value m a
demoteD = DerefC . runDerefC
promoteD :: DerefC address value m a -> DerefC (Located address) value m a
promoteD = DerefC . runDerefC
demoteA :: AllocatorC (Located address) m a -> AllocatorC address m a
demoteA = AllocatorC . runAllocatorC
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
@ -47,6 +36,9 @@ instance ( Carrier (Allocator address :+: sig) (AllocatorC address m)
where alg (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