github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +03:00
Code Issues Projects Releases Wiki Activity

Customize the default eval to show the constructor.

Browse Source
This commit is contained in:
Rob Rix 2017-11-29 13:07:15 -05:00
parent f569fe74db
commit 797330650f
2 changed files with 3 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Abstract/Eval.hs
View File

@ -12,6 +12,7 @@ import Abstract.Value
import Control.Monad.Effect
import Control.Monad.Effect.Reader
import Control.Monad.Fail
import Data.Functor.Classes
import Data.Proxy
import Data.Semigroup
import qualified Data.Set as Set
@ -23,8 +24,8 @@ import Prelude hiding (fail)
-- Collecting evaluator
class Monad m => Eval v m constr where
eval :: FreeVariables term => ((v -> m v) -> term -> m v) -> (v -> m w) -> constr term -> m w
default eval :: (FreeVariables term, MonadFail m) => ((v -> m v) -> term -> m v) -> (v -> m w) -> constr term -> m w
eval _ _ _ = fail "default eval"
default eval :: (FreeVariables term, MonadFail m, Show1 constr) => ((v -> m v) -> term -> m v) -> (v -> m w) -> constr term -> m w
eval _ _ expr = fail $ "Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr ""
instance (Monad m, Apply (Eval v m) fs) => Eval v m (Union fs) where
eval ev yield = apply (Proxy :: Proxy (Eval v m)) (eval ev yield)

1
src/Data/Syntax.hs
View File

@ -183,7 +183,6 @@ instance Eq1 Error where liftEq = genericLiftEq
instance Ord1 Error where liftCompare = genericLiftCompare
instance Show1 Error where liftShowsPrec = genericLiftShowsPrec
-- TODO: Define Value semantics for Error
instance (MonadFail m) => Eval v m Error
errorSyntax :: Error.Error String -> [a] -> Error a