mirror of
https://github.com/github/semantic.git
synced 2025-01-09 00:56:32 +03:00
New Eval type class to go with
This commit is contained in:
parent
47c60e7807
commit
552576f80c
@ -49,6 +49,7 @@ library
|
|||||||
, Data.Abstract.Environment
|
, Data.Abstract.Environment
|
||||||
, Data.Abstract.Linker
|
, Data.Abstract.Linker
|
||||||
, Data.Abstract.Eval
|
, Data.Abstract.Eval
|
||||||
|
, Data.Abstract.Eval2
|
||||||
, Data.Abstract.FreeVariables
|
, Data.Abstract.FreeVariables
|
||||||
, Data.Abstract.Live
|
, Data.Abstract.Live
|
||||||
, Data.Abstract.Store
|
, Data.Abstract.Store
|
||||||
|
63
src/Data/Abstract/Eval2.hs
Normal file
63
src/Data/Abstract/Eval2.hs
Normal file
@ -0,0 +1,63 @@
|
|||||||
|
{-# LANGUAGE DefaultSignatures, MultiParamTypeClasses, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
|
||||||
|
module Data.Abstract.Eval2
|
||||||
|
( Eval(..)
|
||||||
|
, MonadGC(..)
|
||||||
|
, MonadFail(..)
|
||||||
|
, Recursive(..)
|
||||||
|
, Base
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Effect.Env
|
||||||
|
import Control.Monad.Effect.GC
|
||||||
|
import Control.Monad.Fail
|
||||||
|
import Data.Abstract.Environment
|
||||||
|
import Data.Abstract.FreeVariables
|
||||||
|
import Data.Abstract.Value
|
||||||
|
import Data.Functor.Classes
|
||||||
|
import Data.Proxy
|
||||||
|
import Data.Term
|
||||||
|
import Data.Union
|
||||||
|
import Data.Functor.Foldable (Base, Recursive(..), project)
|
||||||
|
import Prelude hiding (fail)
|
||||||
|
|
||||||
|
-- | The 'Eval' 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 Monad m => Eval term v m constr where
|
||||||
|
eval :: constr term -> m v
|
||||||
|
|
||||||
|
default eval :: (MonadFail m, Show1 constr) => (constr term -> m v)
|
||||||
|
eval expr = fail $ "Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr ""
|
||||||
|
|
||||||
|
-- | If we can evaluate any syntax which can occur in a 'Union', we can evaluate the 'Union'.
|
||||||
|
instance (Monad m, Apply (Eval t v m) fs) => Eval t v m (Union fs) where
|
||||||
|
eval = apply (Proxy :: Proxy (Eval t v m)) eval
|
||||||
|
|
||||||
|
-- | Evaluating a 'TermF' ignores its annotation, evaluating the underlying syntax.
|
||||||
|
instance (Monad m, Eval t v m s) => Eval t v m (TermF s a) where
|
||||||
|
eval In{..} = eval termFOut
|
||||||
|
|
||||||
|
-- | '[]' is treated as an imperative sequence of statements/declarations s.t.:
|
||||||
|
--
|
||||||
|
-- 1. Each statement’s effects on the store are accumulated;
|
||||||
|
-- 2. Each statement can affect the environment of later statements (e.g. by yielding under 'localEnv'); and
|
||||||
|
-- 3. Only the last statement’s return value is returned.
|
||||||
|
--
|
||||||
|
-- This also allows e.g. early returns to be implemented in the middle of a list, by means of a statement returning instead of yielding. Therefore, care must be taken by 'Eval' instances in general to yield and not simply return, or else they will unintentionally short-circuit control and skip the rest of the scope.
|
||||||
|
instance ( Monad m
|
||||||
|
, Ord (LocationFor v)
|
||||||
|
-- , MonadGC v m
|
||||||
|
-- , MonadEnv v m
|
||||||
|
, AbstractValue v
|
||||||
|
, Recursive t
|
||||||
|
-- , FreeVariables t
|
||||||
|
, Eval t v m (Base t)
|
||||||
|
)
|
||||||
|
=> Eval t v m [] where
|
||||||
|
eval [] = pure unit
|
||||||
|
eval [x] = eval (project x)
|
||||||
|
-- eval ev yield [a] = ev pure a >>= yield
|
||||||
|
-- eval ev yield (a:as) = do
|
||||||
|
-- env <- askEnv :: m (Environment (LocationFor v) v)
|
||||||
|
-- extraRoots (envRoots env (freeVariables1 as)) (ev (const (eval ev pure as)) a) >>= yield
|
||||||
|
|
||||||
|
-- Default should be to yield
|
||||||
|
-- Allow "return" to short circuit the rest of the imperative scope
|
Loading…
Reference in New Issue
Block a user