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

Reduce duplication

Browse Source
This commit is contained in:
Timothy Clem 2018-02-16 09:17:53 -08:00
parent 8fb782eba5
commit 9d52485d9e
1 changed files with 7 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Data/Syntax.hs
View File

@ -163,19 +163,17 @@ instance ( Monad m
=> Eval t (Value l t) m Program where
eval ev yield (Program xs) = eval' ev yield xs
where
eval' _ yield [] = do
env <- askEnv @(Value l t)
let v = inj (Value.Interface (unit :: Value l t) env) :: Value l t
yield v
eval' ev yield [a] = do
env <- askEnv @(Value l t)
v1 <- ev pure a
let v = inj (Value.Interface (v1 :: Value l t) env) :: Value l t
yield v
eval' _ _ [] = injectAndYield unit
eval' ev _ [a] = ev pure a >>= injectAndYield
eval' ev yield (a:as) = do
env <- askEnv @(Value l t)
extraRoots (envAll env) (ev (const (eval' ev pure as)) a) >>= yield
injectAndYield :: Value l t -> m (Value l t)
injectAndYield val = do
env <- askEnv @(Value l t)
yield $ inj (Value.Interface val env)
instance ( Monad m
, Ord Type.Type
, MonadGC Type.Type m