diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs index 82dc1f643..e0e93cc82 100644 --- a/src/Analysis/Abstract/Evaluating.hs +++ b/src/Analysis/Abstract/Evaluating.hs @@ -13,7 +13,6 @@ import Data.Abstract.Store import Data.Abstract.Value import Data.Abstract.FreeVariables import Data.Blob -import Data.Traversable import Data.Function (fix) import Data.Functor.Foldable (Base, Recursive(..)) import Data.Foldable (toList) @@ -21,124 +20,9 @@ import Data.Semigroup import Prelude hiding (fail) import qualified Data.Map as Map import System.FilePath.Posix -import Data.Union import qualified Data.ByteString.Char8 as BC --- -- | The effects necessary for concrete interpretation. --- -- --- -- NOTE: Uses a memoizing linker strategy. --- type Evaluating t v --- = '[ Fail --- , State (Store (LocationFor v) v) --- , State (EnvironmentFor v) -- Global (imperative) environment --- , Reader (EnvironmentFor v) -- Local environment (e.g. binding over a closure) --- , State (Linker t v) --- ] --- --- -- | Require/import another file and return an Effect. --- require :: forall v term es. --- ( Member Fail es --- , Member (State (Linker term v)) es --- , Evaluatable es term v (Base term) --- , Recursive term --- , FreeVariables term) --- => term -> Eff es v --- require term = do --- let [name'] = toList (freeVariables term) --- let name = BC.unpack name' --- linker <- get @(Linker term v) --- maybe (evalModule linker name) pure (linkerLookupValue name linker) --- where --- evalModule linker name = case linkerLookupTerm name linker of --- Just m -> do --- v <- step @v m --- modify @(Linker term v) (linkerInsert name v) --- pure v --- _ -> fail ("cannot find " <> show name) --- --- -- | Evaluate a term to a value. --- evaluate :: forall v term. --- ( Ord v --- , Ord (LocationFor v) --- , Evaluatable (Evaluating term v) term v (Base term) --- , Recursive term --- ) --- => term --- -> Final (Evaluating term v) v --- evaluate = run @(Evaluating term v) . fix (const step) --- --- -- | Evaluate terms and an entry point to a value. --- evaluates :: forall v term. --- ( Ord v --- , Ord (LocationFor v) --- , Evaluatable (Evaluating term v) term v (Base term) --- , Recursive term --- ) --- => [(Blob, term)] -- List of (blob, term) pairs that make up the program to be evaluated --- -> (Blob, term) -- Entrypoint --- -> Final (Evaluating term v) v --- evaluates pairs = run @(Evaluating term v) . fix go --- where --- go _ (Blob{..}, t) = do --- put (Linker @term @v Map.empty (Map.fromList (fmap toPathActionPair pairs))) --- step @v t --- toPathActionPair (Blob{..}, t) = (dropExtensions blobPath, t) - - --- -- | The effects necessary for concrete interpretation. --- -- --- -- NOTE: Uses a lazy, non-memoized linker strategy where Effects are stored in the linker and run each time they are needed. --- type Evaluating v --- = '[ Fail --- , State (Store (LocationFor v) v) --- , State (EnvironmentFor v) -- Global (imperative) environment --- , Reader (EnvironmentFor v) -- Local environment (e.g. binding over a closure) --- , Reader (Linker (Evaluator v)) --- ] --- --- newtype Evaluator v = Evaluator { runEvaluator :: Eff (Evaluating v) v } --- --- -- | Require/import another file and return an Effect. --- require :: forall v term es. --- ( Members (Evaluating v) es --- , FreeVariables term --- ) --- => term -> Eff es v --- require term = do --- let [name'] = toList (freeVariables term) --- let name = BC.unpack name' --- linker <- ask @(Linker (Evaluator v)) --- maybe (fail ("cannot find " <> show name)) (raiseEmbedded . runEvaluator) (linkerLookup name linker) --- --- -- | Evaluate a term to a value. --- evaluate :: forall v term. --- ( Ord v --- , Ord (LocationFor v) --- , Evaluatable (Evaluating v) term v (Base term) --- , Recursive term --- ) --- => term --- -> Final (Evaluating v) v --- evaluate = run @(Evaluating v) . fix (const step) --- --- -- | Evaluate terms and an entry point to a value. --- evaluates :: forall v term. --- ( Ord v --- , Ord (LocationFor v) --- , Evaluatable (Evaluating v) term v (Base term) --- , Recursive term --- ) --- => [(Blob, term)] -- List of (blob, term) pairs that make up the program to be evaluated --- -> (Blob, term) -- Entrypoint --- -> Final (Evaluating v) v --- evaluates pairs = run @(Evaluating v) . fix go --- where --- go _ (Blob{..}, t) = local (const (Linker (Map.fromList (map toPathActionPair pairs)))) (step @v t) --- toPathActionPair (Blob{..}, t) = (dropExtensions blobPath, Evaluator (step @v t)) - - - -- | The effects necessary for concrete interpretation. type Evaluating v = '[ Fail