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

Make ref throw the error.

Browse Source
This commit is contained in:
Rob Rix 2018-12-10 09:51:08 -05:00
parent 03fda04500
commit 3d2ced84c3
4 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Data/Abstract/Evaluatable.hs
View File

@ -88,14 +88,17 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
, Member (Resumable (BaseError (EvalError address value))) sig , Member (Resumable (BaseError (EvalError address value))) sig
, Member (Resumable (BaseError (HeapError address))) sig , Member (Resumable (BaseError (HeapError address))) sig
, Member (Resumable (BaseError (ScopeError address))) sig , Member (Resumable (BaseError (ScopeError address))) sig
, Member (Resumable (BaseError (UnspecializedError value))) sig
, Member (State (Heap address address value)) sig , Member (State (Heap address address value)) sig
, Member (State (ScopeGraph address)) sig , Member (State (ScopeGraph address)) sig
, Ord address , Ord address
) )
=> (term -> Evaluator term address value m value) => (term -> Evaluator term address value m value)
-> (term -> Evaluator term address value m (Slot address)) -> (term -> Evaluator term address value m (Slot address))
-> (constr term -> Evaluator term address value m (Maybe (Slot address))) -> (constr term -> Evaluator term address value m (Slot address))
ref _ _ _ = pure Nothing ref _ _ expr = do
_ <- throwUnspecializedError $ UnspecializedError ("ref unspecialized for " <> liftShowsPrec (const (const id)) (const id) 0 expr "")
throwEvalError RefError
traceResolve :: (Show a, Show b, Member Trace sig, Carrier sig m) => a -> b -> Evaluator term address value m () traceResolve :: (Show a, Show b, Member Trace sig, Carrier sig m) => a -> b -> Evaluator term address value m ()

2
src/Data/Syntax.hs
View File

@ -171,7 +171,7 @@ instance Evaluatable Identifier where
ref _ _ (Identifier name) = do ref _ _ (Identifier name) = do
reference (Reference name) (Declaration name) reference (Reference name) (Declaration name)
Just <$> lookupDeclaration (Declaration name) lookupDeclaration (Declaration name)
instance Tokenize Identifier where instance Tokenize Identifier where

4
src/Data/Syntax/Expression.hs
View File

@ -536,8 +536,8 @@ instance Evaluatable MemberAccess where
Just lhsFrame -> Just lhsFrame ->
withScopeAndFrame lhsFrame $ do withScopeAndFrame lhsFrame $ do
reference (Reference rhs) (Declaration rhs) reference (Reference rhs) (Declaration rhs)
Just <$> lookupDeclaration (Declaration rhs) lookupDeclaration (Declaration rhs)
Nothing -> pure Nothing -- FIXME: this should really be throwing Nothing -> throwEvalError RefError
instance Tokenize MemberAccess where instance Tokenize MemberAccess where

2
src/Semantic/Analysis.hs
View File

@ -150,4 +150,4 @@ evalTerm :: ( Carrier sig m
) )
=> Open (term -> Evaluator term address value m (ValueRef address value)) => Open (term -> Evaluator term address value m (ValueRef address value))
-> term -> Evaluator term address value m (ValueRef address value) -> term -> Evaluator term address value m (ValueRef address value)
evalTerm perTerm = fst (fix (\ (ev, re) -> (perTerm (eval ev re . project), maybeM (throwEvalError RefError) <=< ref (value <=< ev) re . project))) evalTerm perTerm = fst (fix (\ (ev, re) -> (perTerm (eval ev re . project), ref (value <=< ev) re . project)))