1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 06:11:49 +03:00

Move the AbstractValue constraint onto evaluation.

This commit is contained in:
Rob Rix 2018-03-01 11:18:53 -05:00
parent 06d24471f3
commit b25c9e6cd3
2 changed files with 6 additions and 1 deletions

View File

@ -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)

View File

@ -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