github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'sequence-values-in-the-abstract-domain' into scope-graphs

Browse Source
This commit is contained in:
Rob Rix 2019-07-25 12:57:07 -04:00
commit f6cd84eba7
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
3 changed files with 25 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
semantic-core/src/Analysis/Concrete.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RecordWildCards, TypeOperators, UndecidableInstances #-}
{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RecordWildCards, TypeOperators, UndecidableInstances #-}
module Analysis.Concrete
( Concrete(..)
, concrete
@ -28,6 +28,7 @@ import qualified Data.IntSet as IntSet
import Data.Loc
import qualified Data.Map as Map
import Data.Name
import Data.Semigroup (Last (..))
import qualified Data.Set as Set
import Data.Term
import Data.Text (Text, pack)
@ -47,6 +48,7 @@ data Concrete
| String Text
| Record Env
deriving (Eq, Ord, Show)
deriving Semigroup via Last Concrete
recordFrame :: Concrete -> Maybe Env
recordFrame (Record frame) = Just frame

33
semantic-core/src/Analysis/Eval.hs
View File

@ -30,6 +30,7 @@ import Prelude hiding (fail)
eval :: ( Carrier sig m
, Member (Reader Loc) sig
, MonadFail m
, Semigroup value
)
=> Analysis address value m
-> (Term Core User -> m value)
@ -41,12 +42,12 @@ eval Analysis{..} eval = \case
addr <- alloc n
v <- bind n addr (eval (instantiate1 (pure n) b))
v <$ assign addr v
a :>> b -> eval a >> eval b
a :>> b -> (<>) <$> eval a <*> eval b
Named (Ignored n) a :>>= b -> do
a' <- eval a
addr <- alloc n
assign addr a'
bind n addr (eval (instantiate1 (pure n) b))
bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
Lam (Named (Ignored n) b) -> abstract eval n (instantiate1 (pure n) b)
f :$ a -> do
f' <- eval f
@ -210,18 +211,18 @@ ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' stateme
data Analysis address value m = Analysis
{ alloc :: User -> m address
, bind :: forall a . User -> address -> m a -> m a
, lookupEnv :: User -> m (Maybe address)
, deref :: address -> m (Maybe value)
, assign :: address -> value -> m ()
, abstract :: (Term Core User -> m value) -> User -> Term Core User -> m value
, apply :: (Term Core User -> m value) -> value -> value -> m value
, unit :: m value
, bool :: Bool -> m value
, asBool :: value -> m Bool
, string :: Text -> m value
, asString :: value -> m Text
, record :: [(User, value)] -> m value
, (...) :: address -> User -> m (Maybe address)
{ alloc :: User -> m address
, bind :: forall a . User -> address -> m a -> m a
, lookupEnv :: User -> m (Maybe address)
, deref :: address -> m (Maybe value)
, assign :: address -> value -> m ()
, abstract :: (Term Core User -> m value) -> User -> Term Core User -> m value
, apply :: (Term Core User -> m value) -> value -> value -> m value
, unit :: m value
, bool :: Bool -> m value
, asBool :: value -> m Bool
, string :: Text -> m value
, asString :: value -> m Text
, record :: [(User, value)] -> m value
, (...) :: address -> User -> m (Maybe address)
}

6
semantic-core/src/Analysis/Typecheck.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, FlexibleInstances, LambdaCase, OverloadedStrings, QuantifiedConstraints, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators #-}
{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, OverloadedStrings, QuantifiedConstraints, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators #-}
module Analysis.Typecheck
( Monotype (..)
, Meta
@ -30,6 +30,7 @@ import qualified Data.Map as Map
import Data.Maybe (fromJust, fromMaybe)
import Data.Name as Name
import Data.Scope
import Data.Semigroup (Last (..))
import qualified Data.Set as Set
import Data.Term
import Data.Void
@ -44,6 +45,9 @@ data Monotype f a
| Record (Map.Map User (f a))
deriving (Foldable, Functor, Generic1, Traversable)
-- FIXME: Union the effects/annotations on the operands.
deriving via (Last (Term Monotype a)) instance Semigroup (Term Monotype a)
deriving instance (Eq a, forall a . Eq a => Eq (f a), Monad f) => Eq (Monotype f a)
deriving instance (Ord a, forall a . Eq a => Eq (f a)
, forall a . Ord a => Ord (f a), Monad f) => Ord (Monotype f a)