1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +03:00
semantic/test/Control/Abstract/Evaluator/Spec.hs

121 lines
4.7 KiB
Haskell
Raw Normal View History

{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
2018-05-09 19:36:40 +03:00
module Control.Abstract.Evaluator.Spec
( spec
) where
2018-05-07 21:21:05 +03:00
2018-12-07 20:38:16 +03:00
import Control.Abstract as Abstract
import qualified Control.Abstract.Heap as Heap
2019-07-15 22:23:29 +03:00
import Control.Effect.Lift
2018-12-05 18:14:16 +03:00
import Data.Abstract.Address.Precise as Precise
import Data.Abstract.BaseError
import Data.Abstract.Evaluatable
import Data.Abstract.Module
import qualified Data.Abstract.Number as Number
import Data.Abstract.Package
import qualified Data.Abstract.ScopeGraph as ScopeGraph
2018-12-05 18:14:16 +03:00
import Data.Abstract.Value.Concrete as Value
2019-03-28 01:57:55 +03:00
import qualified Data.Language as Language
2018-12-05 18:14:16 +03:00
import qualified Data.Map.Strict as Map
import Data.Sum
import SpecHelpers hiding (reassociate)
import System.IO.Unsafe (unsafePerformIO)
2018-05-07 21:21:05 +03:00
spec :: Spec
2019-06-20 00:22:09 +03:00
spec = do
2018-05-07 22:10:41 +03:00
it "constructs integers" $ do
2018-12-18 19:19:47 +03:00
(_, (_, (_, expected))) <- evaluate (integer 123)
2018-12-07 22:46:41 +03:00
expected `shouldBe` Right (Value.Integer (Number.Integer 123))
2018-05-07 23:06:21 +03:00
it "calls functions" $ do
2018-12-10 18:48:25 +03:00
(_, (_, (_, expected))) <- evaluate . withLexicalScopeAndFrame $ do
2018-12-07 22:46:41 +03:00
currentScope' <- currentScope
let lexicalEdges = Map.singleton Lexical [ currentScope' ]
x = SpecHelpers.name "x"
associatedScope <- newScope lexicalEdges
2019-02-20 23:45:52 +03:00
declare (ScopeGraph.Declaration "identity") Default Public emptySpan ScopeGraph.Function (Just associatedScope)
2018-12-07 22:46:41 +03:00
withScope associatedScope $ do
2019-02-20 23:45:52 +03:00
declare (Declaration x) Default Public emptySpan ScopeGraph.RequiredParameter Nothing
2018-12-07 22:46:41 +03:00
identity <- function "identity" [ x ]
(SpecEff (Heap.lookupSlot (ScopeGraph.Declaration (SpecHelpers.name "x")) >>= deref)) associatedScope
2018-12-18 19:19:47 +03:00
val <- integer 123
2018-12-07 22:46:41 +03:00
call identity [val]
2018-12-18 19:19:47 +03:00
expected `shouldBe` Right (Value.Integer (Number.Integer 123))
2018-05-07 23:06:21 +03:00
2018-05-07 22:10:11 +03:00
evaluate
2018-05-07 22:13:01 +03:00
= runM
2018-10-24 16:47:24 +03:00
. runTraceByIgnoring
. runState (lowerBound @(ScopeGraph Precise))
. runState (lowerBound @(Heap Precise Precise Val))
2018-10-24 16:47:24 +03:00
. runFresh
. runReader (PackageInfo (SpecHelpers.name "test") mempty)
2019-03-28 01:57:55 +03:00
. runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs" Language.Haskell mempty)
. evalState (lowerBound @Span)
2018-08-06 19:29:24 +03:00
. runReader (lowerBound @Span)
. runEvaluator
2018-10-24 17:01:55 +03:00
. runAllocator
. evalModule
where
evalModule action = do
scopeAddress <- newScope mempty
frameAddress <- newFrame scopeAddress mempty
val <- raiseHandler (runReader (CurrentScope scopeAddress))
. raiseHandler (runReader (CurrentFrame frameAddress))
. fmap reassociate
. runScopeError
. runHeapError
. runValueError
. runAddressError
. runEvalError
2019-03-06 18:12:10 +03:00
. runDeref @SpecEff
. runAllocator
. runReturn
. runLoopControl
2018-12-18 19:19:47 +03:00
. runNumeric
. runBoolean
. runFunction runSpecEff
$ action
pure ((scopeAddress, frameAddress), val)
reassociate :: Either (SomeError exc1) (Either (SomeError exc2) (Either (SomeError exc3) (Either (SomeError exc4) (Either (SomeError exc5) result)))) -> Either (SomeError (Sum '[exc5, exc4, exc3, exc2, exc1])) result
reassociate = mergeErrors . mergeErrors . mergeErrors . mergeErrors . mergeErrors . Right
type Val = Value SpecEff Precise
2018-09-25 22:41:57 +03:00
newtype SpecEff = SpecEff
{ runSpecEff :: Evaluator SpecEff Precise Val (FunctionC SpecEff Precise Val
2019-03-06 18:12:10 +03:00
(BooleanC Val
(NumericC Val
(ErrorC (LoopControl Val)
(ErrorC (Return Val)
(AllocatorC Precise
(DerefC Precise Val
(ResumableC (BaseError (EvalError SpecEff Precise Val))
(ResumableC (BaseError (AddressError Precise Val))
(ResumableC (BaseError (ValueError SpecEff Precise))
(ResumableC (BaseError (HeapError Precise))
(ResumableC (BaseError (ScopeError Precise))
(ReaderC (CurrentFrame Precise)
(ReaderC (CurrentScope Precise)
(AllocatorC Precise
(ReaderC Span
(StateC Span
(ReaderC ModuleInfo
(ReaderC PackageInfo
(FreshC
(StateC (Heap Precise Precise Val)
(StateC (ScopeGraph Precise)
(TraceByIgnoringC
(LiftC IO))))))))))))))))))))))))
2018-12-07 23:20:55 +03:00
Val
}
2018-09-25 22:41:57 +03:00
instance Eq SpecEff where _ == _ = True
instance Show SpecEff where show _ = "_"
instance FreeVariables SpecEff where freeVariables _ = lowerBound
instance Declarations SpecEff where
declaredName eff =
2018-12-07 23:20:55 +03:00
case unsafePerformIO (evaluate (runSpecEff eff)) of
(_, (_, (_, Right (Value.String text)))) -> Just (SpecHelpers.name text)
2018-12-07 22:46:41 +03:00
_ -> error "declaredName for SpecEff should return an RVal"