From 08318707d950528750ae1930da3f2fc87fce7ba2 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 22 Nov 2017 10:19:22 -0800 Subject: [PATCH] EvalCollect instances --- src/Abstract/Eval.hs | 5 +++++ src/Data/Syntax.hs | 6 ++++++ src/Data/Syntax/Comment.hs | 1 + src/Data/Syntax/Declaration.hs | 1 + src/Data/Syntax/Expression.hs | 1 + src/Data/Syntax/Literal.hs | 3 +++ src/Data/Syntax/Type.hs | 1 + 7 files changed, 18 insertions(+) diff --git a/src/Abstract/Eval.hs b/src/Abstract/Eval.hs index 370f80000..118e5e504 100644 --- a/src/Abstract/Eval.hs +++ b/src/Abstract/Eval.hs @@ -41,6 +41,11 @@ instance ( Monad m => EvalCollect l v m s a (Union fs) where evalCollect ev = apply (Proxy :: Proxy (EvalCollect l v m s a)) (evalCollect @l ev) +instance ( Monad m + , EvalCollect l v m s a s + ) + => EvalCollect l v m s a (TermF s a) where + evalCollect ev In{..} = evalCollect @l ev termOut class Monad m => MonadGC l a m where askRoots :: m (Set (Address l a)) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 40bb56816..b51872258 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -119,6 +119,7 @@ instance Eq1 Identifier where liftEq = genericLiftEq instance Ord1 Identifier where liftCompare = genericLiftCompare instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec -- TODO: Implement Eval instance for Identifier +instance (Monad m) => EvalCollect l (Value s a l) m s a Identifier instance (Monad m) => Eval (Value s a l) m s a Identifier newtype Program a = Program [a] @@ -128,6 +129,7 @@ instance Eq1 Program where liftEq = genericLiftEq instance Ord1 Program where liftCompare = genericLiftCompare instance Show1 Program where liftShowsPrec = genericLiftShowsPrec -- TODO: Implement Eval instance for Program +instance (Monad m) => EvalCollect l (Value s a l) m s a Program instance (Monad m) => Eval (Value s a l) m s a Program where eval ev (Program xs) = foldl (\_ a -> ev a) (pure (I PNoOp)) xs @@ -150,6 +152,7 @@ instance Eq1 Empty where liftEq _ _ _ = True instance Ord1 Empty where liftCompare _ _ _ = EQ instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty" -- TODO: Define Value semantics for Empty +instance (Monad m) => EvalCollect l (Value s a l) m s a Empty instance (Monad m) => Eval (Value s a l) m s a Empty where eval _ _ = pure (I PNoOp) @@ -162,6 +165,7 @@ instance Eq1 Error where liftEq = genericLiftEq instance Ord1 Error where liftCompare = genericLiftCompare instance Show1 Error where liftShowsPrec = genericLiftShowsPrec -- TODO: Define Value semantics for Error +instance (Monad m) => EvalCollect l (Value s a l) m s a Error instance (Monad m) => Eval (Value s a l) m s a Error errorSyntax :: Error.Error String -> [a] -> Error a @@ -197,10 +201,12 @@ instance Diffable Context where instance Eq1 Context where liftEq = genericLiftEq instance Ord1 Context where liftCompare = genericLiftCompare instance Show1 Context where liftShowsPrec = genericLiftShowsPrec +instance (Monad m) => EvalCollect l (Value s a l) m s a Context instance (Monad m) => Eval (Value s a l) m s a Context where eval ev Context{..} = ev contextSubject -- TODO: Find a better place for this -- TODO: Define Value semantics for [] +instance Monad m => EvalCollect l (Value s a l) m s a [] instance Monad m => Eval (Value s a l) m s a [] where eval _ _ = pure (I PNoOp) diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index d5d0d083a..9a4202a6d 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -20,6 +20,7 @@ instance Eq1 Comment where liftEq = genericLiftEq instance Ord1 Comment where liftCompare = genericLiftCompare instance Show1 Comment where liftShowsPrec = genericLiftShowsPrec +instance (Monad m) => EvalCollect l (Value s a l) m s a Comment instance (Monad m) => Eval (Value s a l) m s a Comment -- TODO: nested comment types diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index e7453d2be..011ad886d 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -20,6 +20,7 @@ instance Diffable Function where instance Eq1 Function where liftEq = genericLiftEq instance Ord1 Function where liftCompare = genericLiftCompare instance Show1 Function where liftShowsPrec = genericLiftShowsPrec +instance (Monad m) => EvalCollect l (Value s a l) m s a Function instance (Monad m) => Eval (Value s a l) m s a Function -- TODO: How should we represent function types, where applicable? diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 438cd074e..0c96d5dc5 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -18,6 +18,7 @@ data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a] instance Eq1 Call where liftEq = genericLiftEq instance Ord1 Call where liftCompare = genericLiftCompare instance Show1 Call where liftShowsPrec = genericLiftShowsPrec +instance (Monad m) => EvalCollect l (Value s a l) m s a Call instance (Monad m) => Eval (Value s a l) m s a Call diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index 091ac288a..2934fa78b 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -28,6 +28,7 @@ false = Boolean False instance Eq1 Boolean where liftEq = genericLiftEq instance Ord1 Boolean where liftCompare = genericLiftCompare instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec +instance (Monad m) => EvalCollect l (Value s a l) m s a Boolean instance (Monad m) => Eval (Value s a l) m s a Boolean where eval _ (Boolean x) = pure (I (PBool x)) @@ -41,6 +42,7 @@ newtype Integer a = Integer { integerContent :: ByteString } instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Integer where liftCompare = genericLiftCompare instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShowsPrec +instance (Monad m) => EvalCollect l (Value s a l) m s a Data.Syntax.Literal.Integer instance (Monad m) => Eval (Value s a l) m s a Data.Syntax.Literal.Integer -- TODO: Should IntegerLiteral hold an Integer instead of a ByteString? @@ -99,6 +101,7 @@ newtype TextElement a = TextElement { textElementContent :: ByteString } instance Eq1 TextElement where liftEq = genericLiftEq instance Ord1 TextElement where liftCompare = genericLiftCompare instance Show1 TextElement where liftShowsPrec = genericLiftShowsPrec +instance (Monad m) => EvalCollect l (Value s a l) m s a TextElement instance (Monad m) => Eval (Value s a l) m s a TextElement where eval _ (TextElement x) = pure (I (PString x)) diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs index 897020939..bd2b440b9 100644 --- a/src/Data/Syntax/Type.hs +++ b/src/Data/Syntax/Type.hs @@ -17,6 +17,7 @@ data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a } instance Eq1 Annotation where liftEq = genericLiftEq instance Ord1 Annotation where liftCompare = genericLiftCompare instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec +instance (Monad m) => EvalCollect l (Value s a l) m s a Annotation instance (Monad m) => Eval (Value s a l) m s a Annotation newtype Product a = Product { productElements :: [a] }