1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +03:00

Pass value in Interface

This commit is contained in:
Timothy Clem 2018-02-16 09:06:41 -08:00
parent f6be7cc4ad
commit 4b03b90da5
3 changed files with 18 additions and 17 deletions

View File

@ -39,7 +39,7 @@ instance (Ord location) => Ord1 (Closure location) where liftCompare = genericLi
instance (Show location) => Show1 (Closure location) where liftShowsPrec = genericLiftShowsPrec instance (Show location) => Show1 (Closure location) where liftShowsPrec = genericLiftShowsPrec
-- | A function value consisting of a list of parameters, the body of the function, and an environment of bindings captured by the body. -- | A function value consisting of a list of parameters, the body of the function, and an environment of bindings captured by the body.
data Interface location term = Interface (Environment location (Value location term)) data Interface location term = Interface (Value location term) (Environment location (Value location term))
deriving (Eq, Generic1, Ord, Show) deriving (Eq, Generic1, Ord, Show)
instance (Eq location) => Eq1 (Interface location) where liftEq = genericLiftEq instance (Eq location) => Eq1 (Interface location) where liftEq = genericLiftEq
@ -110,7 +110,7 @@ class AbstractValue v where
instance (FreeVariables term, Ord location) => ValueRoots location (Value location term) where instance (FreeVariables term, Ord location) => ValueRoots location (Value location term) where
valueRoots v valueRoots v
| Just (Closure names body env) <- prj v = envRoots env (foldr Set.delete (freeVariables body) names) | Just (Closure names body env) <- prj v = envRoots env (foldr Set.delete (freeVariables body) names)
| Just (Interface env) <- prj v = envAll env | Just (Interface _ env) <- prj v = envAll env
| otherwise = mempty | otherwise = mempty
-- | Construct a 'Value' wrapping the value arguments (if any). -- | Construct a 'Value' wrapping the value arguments (if any).

View File

@ -12,7 +12,7 @@ import Data.Abstract.Address
import Data.Abstract.Environment import Data.Abstract.Environment
import Data.Abstract.Eval import Data.Abstract.Eval
import Data.Abstract.FreeVariables import Data.Abstract.FreeVariables
import Data.Abstract.Value (LocationFor, AbstractValue(..), Value(..)) import Data.Abstract.Value (LocationFor, AbstractValue(..), Value)
import qualified Data.Abstract.Value as Value import qualified Data.Abstract.Value as Value
import qualified Data.Abstract.Type as Type import qualified Data.Abstract.Type as Type
import Data.Align.Generic import Data.Align.Generic
@ -38,8 +38,6 @@ import GHC.Generics
import GHC.Stack import GHC.Stack
import Prelude hiding (fail) import Prelude hiding (fail)
import Debug.Trace
-- Combinators -- Combinators
-- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children. -- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children.
@ -165,11 +163,16 @@ instance ( Monad m
=> Eval t (Value l t) m Program where => Eval t (Value l t) m Program where
eval ev yield (Program xs) = eval' ev yield xs eval ev yield (Program xs) = eval' ev yield xs
where where
eval' ev _ [] = do eval' _ yield [] = do
env <- askEnv @(Value l t) env <- askEnv @(Value l t)
let v = trace ("env: " <> show env) $ inj (Value.Interface env) :: Value l t let v = inj (Value.Interface (unit :: Value l t) env) :: Value l t
yield v yield v
eval' ev _ (a:as) = do 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' ev yield (a:as) = do
env <- askEnv @(Value l t) env <- askEnv @(Value l t)
extraRoots (envAll env) (ev (const (eval' ev pure as)) a) >>= yield extraRoots (envAll env) (ev (const (eval' ev pure as)) a) >>= yield
@ -177,7 +180,6 @@ instance ( Monad m
, Ord Type.Type , Ord Type.Type
, MonadGC Type.Type m , MonadGC Type.Type m
, MonadEnv Type.Type m , MonadEnv Type.Type m
, AbstractValue Type.Type
, FreeVariables t , FreeVariables t
) => Eval t Type.Type m Program where ) => Eval t Type.Type m Program where
eval ev yield (Program xs) = eval ev yield xs eval ev yield (Program xs) = eval ev yield xs

View File

@ -14,6 +14,7 @@ import Data.Abstract.FreeVariables
import Data.Abstract.Type hiding (Type) import Data.Abstract.Type hiding (Type)
import qualified Data.Abstract.Value as Value import qualified Data.Abstract.Value as Value
import qualified Data.Abstract.Type as Type import qualified Data.Abstract.Type as Type
import qualified Data.ByteString.Char8 as BC
import Data.Abstract.Value import Data.Abstract.Value
import Data.Align.Generic import Data.Align.Generic
import Data.Foldable (toList) import Data.Foldable (toList)
@ -26,9 +27,6 @@ import Diffing.Algorithm
import GHC.Generics import GHC.Generics
import Prelude hiding (fail) import Prelude hiding (fail)
import qualified Data.ByteString.Char8 as BC
import Debug.Trace
data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a } data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
@ -264,7 +262,6 @@ instance Eq1 Import where liftEq = genericLiftEq
instance Ord1 Import where liftCompare = genericLiftCompare instance Ord1 Import where liftCompare = genericLiftCompare
instance Show1 Import where liftShowsPrec = genericLiftShowsPrec instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Import
instance ( Monad m instance ( Monad m
, Show l , Show l
, Show t , Show t
@ -277,11 +274,13 @@ instance ( Monad m
eval _ yield (Import from _ _) = do eval _ yield (Import from _ _) = do
let [name] = toList (freeVariables from) let [name] = toList (freeVariables from)
require <- require (BC.unpack name) interface <- require (BC.unpack name)
Value.Interface env <- maybe (fail ("expected a program, but got: " <> show require)) pure (prj require :: Maybe (Value.Interface l t)) Interface _ env <- maybe
(fail ("expected an interface, but got: " <> show interface))
pure
(prj interface :: Maybe (Value.Interface l t))
trace ("[Import] " <> show name <> ": " <> show require) $ localEnv (envUnion env) (yield interface)
localEnv (envUnion env) (yield require)
instance MonadFail m => Eval t Type.Type m Import instance MonadFail m => Eval t Type.Type m Import