github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-01 19:55:34 +03:00
Code Issues Projects Releases Wiki Activity

Make the ref parameter throw on failure.

Browse Source
This commit is contained in:
Rob Rix 2018-12-10 09:44:54 -05:00
parent e0e8b1b566
commit 9116072186
2 changed files with 3 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -71,7 +71,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
, Show address
)
=> (term -> Evaluator term address value m (ValueRef address value))
-> (term -> Evaluator term address value m (Maybe (Slot address)))
-> (term -> Evaluator term address value m (Slot address))
-> (constr term -> Evaluator term address value m (ValueRef address value))
eval recur _ expr = do
traverse_ recur expr
@ -93,7 +93,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
, Ord address
)
=> (term -> Evaluator term address value m value)
-> (term -> Evaluator term address value m (Maybe (Slot address)))
-> (term -> Evaluator term address value m (Slot address))
-> (constr term -> Evaluator term address value m (Maybe (Slot address)))
ref _ _ _ = pure Nothing

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))
-> term -> Evaluator term address value m (ValueRef address value)
evalTerm perTerm = fst (fix (\ (ev, re) -> (perTerm (eval ev re . project), ref (ev >=> value) re . project)))
evalTerm perTerm = fst (fix (\ (ev, re) -> (perTerm (eval ev (re >=> maybeM (throwEvalError RefError)) . project), ref (ev >=> value) (re >=> maybeM (throwEvalError RefError)) . project)))