1
1
mirror of https://github.com/github/semantic.git synced 2024-12-01 00:33:59 +03:00

Make ref throw the error.

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

View File

@ -88,14 +88,17 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
, Member (Resumable (BaseError (EvalError address value))) sig
, Member (Resumable (BaseError (HeapError address))) sig
, Member (Resumable (BaseError (ScopeError address))) sig
, Member (Resumable (BaseError (UnspecializedError value))) sig
, Member (State (Heap address address value)) sig
, Member (State (ScopeGraph address)) sig
, Ord address
)
=> (term -> Evaluator term address value m value)
-> (term -> Evaluator term address value m (Slot address))
-> (constr term -> Evaluator term address value m (Maybe (Slot address)))
ref _ _ _ = pure Nothing
-> (constr term -> Evaluator term address value m (Slot address))
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 ()

View File

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

View File

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

View File

@ -150,4 +150,4 @@ evalTerm :: ( Carrier sig m
)
=> Open (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)))