mirror of
https://github.com/github/semantic.git
synced 2024-12-22 22:31:36 +03:00
Pass value in Interface
This commit is contained in:
parent
f6be7cc4ad
commit
4b03b90da5
@ -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).
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user