1
1
mirror of https://github.com/github/semantic.git synced 2024-12-30 10:27:45 +03:00

Evaluate nil/null literals.

This commit is contained in:
Patrick Thomson 2018-03-26 12:01:09 -04:00
parent 066fc7cb79
commit 7cd0558266
5 changed files with 22 additions and 7 deletions

View File

@ -95,6 +95,9 @@ class (Monad m, Show value) => MonadValue value m where
-- | Eliminate boolean values. TODO: s/boolean/truthy -- | Eliminate boolean values. TODO: s/boolean/truthy
ifthenelse :: value -> m a -> m a -> m a ifthenelse :: value -> m a -> m a -> m a
-- | Construct the nil/null datatype.
null :: m value
-- | Build a class value from a name and environment. -- | Build a class value from a name and environment.
klass :: Name -- ^ The new class's identifier klass :: Name -- ^ The new class's identifier
-> [value] -- ^ A list of superclasses -> [value] -- ^ A list of superclasses
@ -173,6 +176,8 @@ instance ( Monad m
kvPair k = pure . injValue . Value.KVPair k kvPair k = pure . injValue . Value.KVPair k
null = pure . injValue $ Value.Null
asPair k asPair k
| Just (Value.KVPair k v) <- prjValue k = pure (k, v) | Just (Value.KVPair k v) <- prjValue k = pure (k, v)
| otherwise = fail ("expected key-value pair, got " <> show k) | otherwise = fail ("expected key-value pair, got " <> show k)
@ -305,6 +310,7 @@ instance (Alternative m, MonadEnvironment Type m, MonadFail m, MonadFresh m, Mon
klass _ _ _ = pure Object klass _ _ _ = pure Object
namespace _ _ = pure Type.Unit namespace _ _ = pure Type.Unit
null = pure Type.Null
scopedEnvironment _ = pure mempty scopedEnvironment _ = pure mempty

View File

@ -22,6 +22,7 @@ data Type
| Array [Type] -- ^ Arrays. Note that this is heterogenous. | Array [Type] -- ^ Arrays. Note that this is heterogenous.
| Hash [(Type, Type)] -- ^ Heterogenous key-value maps. | Hash [(Type, Type)] -- ^ Heterogenous key-value maps.
| Object -- ^ Objects. Once we have some notion of inheritance we'll need to store a superclass. | Object -- ^ Objects. Once we have some notion of inheritance we'll need to store a superclass.
| Null -- ^ The null type. Unlike 'Unit', this unifies with any other type.
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
-- TODO: À la carte representation of types. -- TODO: À la carte representation of types.
@ -30,6 +31,8 @@ data Type
-- | Unify two 'Type's. -- | Unify two 'Type's.
unify :: MonadFail m => Type -> Type -> m Type unify :: MonadFail m => Type -> Type -> m Type
unify (a1 :-> b1) (a2 :-> b2) = (:->) <$> unify a1 a2 <*> unify b1 b2 unify (a1 :-> b1) (a2 :-> b2) = (:->) <$> unify a1 a2 <*> unify b1 b2
unify a Null = pure a
unify Null b = pure b
-- FIXME: this should be constructing a substitution. -- FIXME: this should be constructing a substitution.
unify (Var _) b = pure b unify (Var _) b = pure b
unify a (Var _) = pure a unify a (Var _) = pure a

View File

@ -25,6 +25,7 @@ type ValueConstructors
, Integer , Integer
, KVPair , KVPair
, Namespace , Namespace
, Null
, Rational , Rational
, String , String
, Symbol , Symbol
@ -177,6 +178,13 @@ instance Eq1 Hash where liftEq = genericLiftEq
instance Ord1 Hash where liftCompare = genericLiftCompare instance Ord1 Hash where liftCompare = genericLiftCompare
instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec
data Null value = Null
deriving (Eq, Generic1, Ord, Show)
instance Eq1 Null where liftEq = genericLiftEq
instance Ord1 Null where liftCompare = genericLiftCompare
instance Show1 Null where liftShowsPrec = genericLiftShowsPrec
-- | The environment for an abstract value type. -- | The environment for an abstract value type.
type EnvironmentFor v = Environment (LocationFor v) v type EnvironmentFor v = Environment (LocationFor v) v

View File

@ -284,7 +284,7 @@ instance Evaluatable QualifiedImport where
where where
moduleName = freeVariable (subterm from) moduleName = freeVariable (subterm from)
renames importedEnv renames importedEnv
| null xs = fmap prepend (Env.names importedEnv) | Prologue.null xs = fmap prepend (Env.names importedEnv)
| otherwise = xs | otherwise = xs
prefix = freeVariable (subterm alias) prefix = freeVariable (subterm alias)
prepend n = (n, prefix <> n) prepend n = (n, prefix <> n)
@ -307,7 +307,7 @@ instance Evaluatable Import where
where where
moduleName = freeVariable (subterm from) moduleName = freeVariable (subterm from)
renamed importedEnv renamed importedEnv
| null xs = importedEnv | Prologue.null xs = importedEnv
| otherwise = Env.overwrite xs importedEnv | otherwise = Env.overwrite xs importedEnv
-- | Side effect only imports (no symbols made available to the calling environment). -- | Side effect only imports (no symbols made available to the calling environment).

View File

@ -8,8 +8,8 @@ import qualified Data.ByteString.Char8 as B
import Data.Monoid (Endo (..), appEndo) import Data.Monoid (Endo (..), appEndo)
import Data.Scientific (Scientific) import Data.Scientific (Scientific)
import Diffing.Algorithm import Diffing.Algorithm
import Prelude hiding (Float, fail) import Prelude hiding (Float, fail, null)
import Prologue hiding (Set, hash) import Prologue hiding (Set, hash, null)
import Text.Read (readMaybe) import Text.Read (readMaybe)
-- Boolean -- Boolean
@ -169,9 +169,7 @@ instance Eq1 Null where liftEq = genericLiftEq
instance Ord1 Null where liftCompare = genericLiftCompare instance Ord1 Null where liftCompare = genericLiftCompare
instance Show1 Null where liftShowsPrec = genericLiftShowsPrec instance Show1 Null where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Null instance Evaluatable Null where eval = const null
instance Evaluatable Null
newtype Symbol a = Symbol { symbolContent :: ByteString } newtype Symbol a = Symbol { symbolContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)