From b25c9e6cd3881cf1fbeafe4c91a958e7c22437ed Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 1 Mar 2018 11:18:53 -0500 Subject: [PATCH] Move the AbstractValue constraint onto evaluation. --- src/Analysis/Abstract/Evaluating.hs | 4 ++++ src/Control/Monad/Effect/Evaluatable.hs | 3 ++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs index d6ca70f25..49821f174 100644 --- a/src/Analysis/Abstract/Evaluating.hs +++ b/src/Analysis/Abstract/Evaluating.hs @@ -34,6 +34,7 @@ type Evaluating t v -- -- Looks up the term's name in the cache of evaluated modules first, returns a value if found, otherwise loads/evaluates the module. require :: ( AbstractFunction effects term v + , AbstractValue v , Evaluatable (Base term) , FreeVariables term , MonadAddressable (LocationFor v) v (Evaluator effects term v) @@ -49,6 +50,7 @@ require term = getModuleTable >>= maybe (load term) pure . linkerLookup name -- -- Always loads/evaluates. load :: ( AbstractFunction effects term v + , AbstractValue v , Evaluatable (Base term) , FreeVariables term , MonadAddressable (LocationFor v) v (Evaluator effects term v) @@ -74,6 +76,7 @@ moduleName term = let [n] = toList (freeVariables term) in BC.unpack n evaluate :: forall v term. ( Ord (LocationFor v) , AbstractFunction (Evaluating term v) term v + , AbstractValue v , Evaluatable (Base term) , FreeVariables term , MonadAddressable (LocationFor v) v (Evaluator (Evaluating term v) term v) @@ -88,6 +91,7 @@ evaluate = run @(Evaluating term v) . runEvaluator . foldSubterms eval evaluates :: forall v term. ( Ord (LocationFor v) , AbstractFunction (Evaluating term v) term v + , AbstractValue v , Evaluatable (Base term) , FreeVariables term , MonadAddressable (LocationFor v) v (Evaluator (Evaluating term v) term v) diff --git a/src/Control/Monad/Effect/Evaluatable.hs b/src/Control/Monad/Effect/Evaluatable.hs index c23c6fdca..6a4afa959 100644 --- a/src/Control/Monad/Effect/Evaluatable.hs +++ b/src/Control/Monad/Effect/Evaluatable.hs @@ -34,6 +34,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 constr where eval :: ( AbstractFunction effects term value + , AbstractValue value , FreeVariables term , MonadAddressable (LocationFor value) value (Evaluator effects term value) , Ord (LocationFor value) @@ -73,7 +74,7 @@ instance Evaluatable [] where -- to the global environment. localEnv (const (bindEnv (liftFreeVariables (freeVariables . subterm) xs) env)) (eval xs) -class AbstractValue v => AbstractFunction effects t v | v -> t where +class AbstractFunction effects t v | v -> t where abstract :: [Name] -> Subterm t (Evaluator effects t v v) -> Evaluator effects t v v apply :: v -> [Subterm t (Evaluator effects t v v)] -> Evaluator effects t v v