github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +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
import Control.Monad.Effect.Reader import Control.Monad.Effect.Reader
import Control.Monad.Fail import Control.Monad.Fail
import Data.Functor.Classes
import Data.Proxy import Data.Proxy
import Data.Semigroup import Data.Semigroup
import qualified Data.Set as Set import qualified Data.Set as Set
@ -23,8 +24,8 @@ import Prelude hiding (fail)
-- Collecting evaluator -- Collecting evaluator
class Monad m => Eval v m constr where class Monad m => Eval v m constr where
eval :: FreeVariables term => ((v -> m v) -> term -> m v) -> (v -> m w) -> constr term -> m w 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 default eval :: (FreeVariables term, MonadFail m, Show1 constr) => ((v -> m v) -> term -> m v) -> (v -> m w) -> constr term -> m w
eval _ _ _ = fail "default eval" 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 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) 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 Ord1 Error where liftCompare = genericLiftCompare
instance Show1 Error where liftShowsPrec = genericLiftShowsPrec instance Show1 Error where liftShowsPrec = genericLiftShowsPrec
-- TODO: Define Value semantics for Error
instance (MonadFail m) => Eval v m Error instance (MonadFail m) => Eval v m Error
errorSyntax :: Error.Error String -> [a] -> Error a errorSyntax :: Error.Error String -> [a] -> Error a