mirror of
https://github.com/github/semantic.git
synced 2024-11-24 08:54:07 +03:00
🔥 TermEffects.
This commit is contained in:
parent
f18d066c88
commit
3cbf66c57e
@ -8,7 +8,7 @@ import Control.Abstract
|
||||
import Data.Abstract.Module
|
||||
import qualified Data.Abstract.Number as Number
|
||||
import Data.Abstract.Package
|
||||
import qualified Data.Abstract.Value as Value
|
||||
import Data.Abstract.Value as Value
|
||||
import Data.Algebra
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Functor.Const
|
||||
@ -20,13 +20,13 @@ spec :: Spec
|
||||
spec = parallel $ do
|
||||
it "constructs integers" $ do
|
||||
(expected, _) <- evaluate (integer 123)
|
||||
expected `shouldBe` Right (Value.injValue (Value.Integer (Number.Integer 123)))
|
||||
expected `shouldBe` Right (injValue (Value.Integer (Number.Integer 123)))
|
||||
|
||||
it "calls functions" $ do
|
||||
(expected, _) <- evaluate $ do
|
||||
identity <- closure [name "x"] lowerBound (variable (name "x"))
|
||||
call identity [integer 123]
|
||||
expected `shouldBe` Right (Value.injValue (Value.Integer (Number.Integer 123)))
|
||||
expected `shouldBe` Right (injValue (Value.Integer (Number.Integer 123)))
|
||||
|
||||
evaluate
|
||||
= runM
|
||||
@ -43,31 +43,9 @@ evaluate
|
||||
. runGoto lowerBound
|
||||
. constraining
|
||||
|
||||
constraining :: TermEvaluator Value -> TermEvaluator Value
|
||||
constraining :: Evaluator Precise (Value Precise) effects a -> Evaluator Precise (Value Precise) effects a
|
||||
constraining = id
|
||||
|
||||
reassociate :: Either String (Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) result))) -> Either (SomeExc (Sum '[Const String, exc1, exc2, exc3])) result
|
||||
reassociate :: Either Prelude.String (Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) result))) -> Either (SomeExc (Sum '[Const Prelude.String, exc1, exc2, exc3])) result
|
||||
reassociate (Left s) = Left (SomeExc (injectSum (Const s)))
|
||||
reassociate (Right (Right (Right (Right a)))) = Right a
|
||||
|
||||
type TermEffects
|
||||
= '[ LoopControl Value
|
||||
, Return Value
|
||||
, Resumable (AddressError Precise Value)
|
||||
, Resumable (EnvironmentError Value)
|
||||
, Resumable (Value.ValueError Precise)
|
||||
, Reader ModuleInfo
|
||||
, Reader PackageInfo
|
||||
, Fail
|
||||
, Fresh
|
||||
, Reader (Environment Precise Value)
|
||||
, State (Environment Precise Value)
|
||||
, State (Heap Precise Value)
|
||||
, State (ModuleTable (Maybe (Environment Precise Value, Value)))
|
||||
, State (Exports Precise Value)
|
||||
, IO
|
||||
]
|
||||
|
||||
type TermEvaluator = Evaluator Precise Value (Goto TermEffects Value ': TermEffects)
|
||||
|
||||
type Value = Value.Value Precise
|
||||
|
Loading…
Reference in New Issue
Block a user