mirror of
https://github.com/github/semantic.git
synced 2024-12-22 14:21:31 +03:00
Removing holding onto val in Interface
This commit is contained in:
parent
ca21d42399
commit
16a4341505
@ -40,7 +40,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 program value consisting of the value of the program and it's enviornment of bindings.
|
-- | A program value consisting of the value of the program and it's enviornment of bindings.
|
||||||
data Interface location term = Interface (Value location term) (Environment location (Value location term))
|
newtype Interface location term = Interface (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
|
||||||
@ -116,7 +116,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).
|
||||||
|
@ -160,10 +160,10 @@ instance ( Ord (LocationFor (Value l t))
|
|||||||
=> Evaluatable es t (Value l t) Program where
|
=> Evaluatable es t (Value l t) Program where
|
||||||
eval (Program xs) = eval' xs
|
eval (Program xs) = eval' xs
|
||||||
where
|
where
|
||||||
interface val = inj . Value.Interface val <$> ask @(EnvironmentFor (Value l t))
|
interface = inj . Value.Interface <$> ask @(EnvironmentFor (Value l t))
|
||||||
|
|
||||||
eval' [] = interface unit
|
eval' [] = interface
|
||||||
eval' [x] = step x >>= interface
|
eval' [x] = step @(Value l t) x >> interface
|
||||||
eval' (x:xs) = do
|
eval' (x:xs) = do
|
||||||
_ <- step @(Value l t) x
|
_ <- step @(Value l t) x
|
||||||
env <- get @(EnvironmentFor (Value l t))
|
env <- get @(EnvironmentFor (Value l t))
|
||||||
|
@ -288,8 +288,7 @@ instance ( Show l
|
|||||||
=> Evaluatable es t (Value l t) Import where
|
=> Evaluatable es t (Value l t) Import where
|
||||||
eval (Import from _ _) = do
|
eval (Import from _ _) = do
|
||||||
interface <- require @(Value l t) @t from
|
interface <- require @(Value l t) @t from
|
||||||
-- TODO: Consider returning the value instead of the interface.
|
Interface env <- maybe
|
||||||
Interface _ env <- maybe
|
|
||||||
(fail ("expected an interface, but got: " <> show interface))
|
(fail ("expected an interface, but got: " <> show interface))
|
||||||
pure
|
pure
|
||||||
(prj interface :: Maybe (Value.Interface l t))
|
(prj interface :: Maybe (Value.Interface l t))
|
||||||
|
Loading…
Reference in New Issue
Block a user