diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs index c1c37e08f..237a17e82 100644 --- a/src/Analysis/Abstract/Evaluating.hs +++ b/src/Analysis/Abstract/Evaluating.hs @@ -71,6 +71,7 @@ moduleName term = let [n] = toList (freeVariables term) in BC.unpack n evaluate :: forall v term. ( Ord v , Ord (LocationFor v) + , AbstractValue term v , Evaluatable (Evaluating v) term v (Base term) , FreeVariables term , Recursive term @@ -83,6 +84,7 @@ evaluate = run @(Evaluating v) . foldSubterms eval evaluates :: forall v term. ( Ord v , Ord (LocationFor v) + , AbstractValue term v , FreeVariables term , Evaluatable (Evaluating v) term v (Base term) , Recursive term diff --git a/src/Control/Monad/Effect/Evaluatable.hs b/src/Control/Monad/Effect/Evaluatable.hs index dd0ea8566..673316b72 100644 --- a/src/Control/Monad/Effect/Evaluatable.hs +++ b/src/Control/Monad/Effect/Evaluatable.hs @@ -26,7 +26,7 @@ import qualified Data.Union as U -- | The 'Evaluatable' class defines the necessary interface for a term to be evaluated. While a default definition of 'eval' is given, instances with computational content must implement 'eval' to perform their small-step operational semantics. class Evaluatable effects term value constr where - eval :: (FreeVariables term) => SubtermAlgebra constr term (Eff effects value) + eval :: (AbstractValue term value, FreeVariables term) => SubtermAlgebra constr term (Eff effects value) default eval :: (Fail :< effects, FreeVariables term, Show1 constr) => SubtermAlgebra constr term (Eff effects value) eval expr = fail $ "Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr "" @@ -50,7 +50,6 @@ instance ( Ord (LocationFor v) , Show (LocationFor v) , (State (EnvironmentFor v) :< es) , (Reader (EnvironmentFor v) :< es) - , AbstractValue t v , FreeVariables t , Evaluatable es t v (Base t) , Recursive t diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index bd360f316..6def944da 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -191,7 +191,7 @@ instance Eq1 Empty where liftEq _ _ _ = True instance Ord1 Empty where liftCompare _ _ _ = EQ instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty" -instance AbstractValue t v => Evaluatable es t v Empty where +instance Evaluatable es t v Empty where eval _ = pure unit diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index 8ec961624..1ea70bde9 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -31,7 +31,7 @@ instance Eq1 Boolean where liftEq = genericLiftEq instance Ord1 Boolean where liftCompare = genericLiftCompare instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec -instance AbstractValue t v => Evaluatable es t v Boolean where +instance Evaluatable es t v Boolean where eval (Boolean x) = pure (boolean x) @@ -45,7 +45,7 @@ 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 AbstractValue t v => Evaluatable es t v Data.Syntax.Literal.Integer where +instance Evaluatable es t v Data.Syntax.Literal.Integer where -- TODO: This instance probably shouldn't have readInteger? eval (Data.Syntax.Literal.Integer x) = pure (integer (maybe 0 fst (readInteger x))) @@ -124,7 +124,7 @@ instance Eq1 TextElement where liftEq = genericLiftEq instance Ord1 TextElement where liftCompare = genericLiftCompare instance Show1 TextElement where liftShowsPrec = genericLiftShowsPrec -instance AbstractValue t v => Evaluatable es t v TextElement where +instance Evaluatable es t v TextElement where eval (TextElement x) = pure (string x) data Null a = Null