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

Simplify the While carriers.

Browse Source
This commit is contained in:
Rob Rix 2018-10-22 12:49:01 -04:00
parent ee077944ca
commit 56eae42043
5 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Control/Abstract/Value.hs
View File

@ -180,13 +180,12 @@ instance HFunctor (While value) where
hmap f (While cond body k) = While (f cond) (f body) k
runWhile :: Carrier (While value :+: sig) (WhileC (Evaluator term address value m))
=> Evaluator term address value (WhileC
(Evaluator term address value m)) a
runWhile :: Carrier (While value :+: sig) (WhileC value (Eff m))
=> Evaluator term address value (WhileC value (Eff m)) a
-> Evaluator term address value m a
runWhile = runWhileC . interpret . runEvaluator
runWhile = raiseHandler $ runWhileC . interpret
newtype WhileC m a = WhileC { runWhileC :: m a }
newtype WhileC value m a = WhileC { runWhileC :: m a }
class Show value => AbstractIntro value where

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

@ -100,8 +100,9 @@ type ModuleC address value m
type ValueC term address value m
= FunctionC term address value (Evaluator term address value
( WhileC (Evaluator term address value
( BooleanC value (Eff m)))))
( WhileC value (Eff
( BooleanC value (Eff
m)))))
evaluate :: ( AbstractValue term address value valueC
, Carrier sig c
@ -110,7 +111,7 @@ evaluate :: ( AbstractValue term address value valueC
, Carrier (Deref value :+: Allocator address :+: Reader ModuleInfo :+: sig) (DerefC address value (Eff allocatorC))
, booleanC ~ BooleanC value (Eff moduleC)
, Carrier (Boolean value :+: moduleSig) booleanC
, whileC ~ WhileC (Evaluator term address value booleanC)
, whileC ~ WhileC value (Eff booleanC)
, moduleSig ~ (Error (LoopControl address) :+: Error (Return address) :+: Env address :+: ScopeEnv address :+: Deref value :+: Allocator address :+: Reader ModuleInfo :+: sig)
, Carrier (While value :+: Boolean value :+: moduleSig) whileC
, Carrier (Function term address value :+: While value :+: Boolean value :+: moduleSig) valueC

9
src/Data/Abstract/Value/Abstract.hs
View File

@ -48,19 +48,20 @@ instance ( Member (Allocator address) sig
instance (Carrier sig m, Alternative m, Monad m) => Carrier (Boolean Abstract :+: sig) (BooleanC Abstract m) where
ret = BooleanC . ret
eff = BooleanC . (alg \/ (eff . handlePure runBooleanC))
eff = BooleanC . (alg \/ eff . handlePure runBooleanC)
where alg (Boolean _ k) = runBooleanC (k Abstract)
alg (AsBool _ k) = runBooleanC (k True) <|> runBooleanC (k False)
alg (Disjunction a b k) = (runBooleanC a <|> runBooleanC b) >>= runBooleanC . k
instance ( Member (Abstract.Boolean Abstract) sig
, Member NonDet sig
, Carrier sig m
, Alternative m
, Monad m
)
=> Carrier (While Abstract :+: sig) (WhileC (Evaluator term address Abstract m)) where
=> Carrier (While Abstract :+: sig) (WhileC Abstract m) where
ret = WhileC . ret
eff = WhileC . (alg \/ (eff . handlePure runWhileC))
eff = WhileC . (alg \/ eff . handlePure runWhileC)
where alg (Abstract.While cond body k) = do
cond' <- runWhileC cond
ifthenelse cond' (runWhileC body *> empty) (runWhileC (k unit))

2
src/Data/Abstract/Value/Concrete.hs
View File

@ -138,7 +138,7 @@ instance ( Member (Reader ModuleInfo) sig
-- , Show address
-- , Show term
-- )
-- => Carrier (Abstract.While (Value term address) :+: sig) (WhileC (Evaluator term address (Value term address) (InterposeC (Resumable (BaseError (UnspecializedError (Value term address)))) (Evaluator term address (Value term address) m)))) where
-- => Carrier (Abstract.While (Value term address) :+: sig) (WhileC (Value term address) (Eff (InterposeC (Resumable (BaseError (UnspecializedError (Value term address)))) m))) where
-- ret = WhileC . ret
-- eff = WhileC . (alg \/ (eff . handlePure runWhileC))
-- where alg = \case

5
src/Data/Abstract/Value/Type.hs
View File

@ -292,10 +292,11 @@ instance ( Member (Reader ModuleInfo) sig
instance ( Member (Abstract.Boolean Type) sig
, Member NonDet sig
, Carrier sig m
, Alternative m
, Monad m
)
=> Carrier (Abstract.While Type :+: sig) (WhileC (Evaluator term address Type m)) where
=> Carrier (Abstract.While Type :+: sig) (WhileC Type m) where
ret = WhileC . ret
eff = WhileC . (alg \/ (eff . handlePure runWhileC))
where alg (Abstract.While cond body k) = do