diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 824f027a5..ccb34da0e 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -5,6 +5,7 @@ import Control.Abstract.Environment import Control.Abstract.Evaluator import Control.Abstract.Heap import Control.Abstract.Value +import qualified Data.Abstract.Environment as Env import Data.Abstract.Name import Data.Text (unpack) import Prologue @@ -23,6 +24,23 @@ define name def = withCurrentCallStack callStack $ do bind name addr def >>= assign addr +defineClass :: ( AbstractValue address value effects + , HasCallStack + , Member (Allocator address value) effects + , Member (Env address) effects + , Member (Reader ModuleInfo) effects + , Member (Reader Span) effects + ) + => Name + -> [Name] + -> Evaluator address value effects a + -> Evaluator address value effects () +defineClass name superclasses scope = define name $ do + env <- locally $ do + void $ scope + Env.head <$> getEnv + klass name (map (string . formatName) superclasses) env + lambda :: (AbstractFunction address value effects, Member Fresh effects) => (Name -> Evaluator address value effects address) -> Evaluator address value effects value