1
1
mirror of https://github.com/github/semantic.git synced 2024-12-21 05:41:54 +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
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.
klass :: Name -- ^ The new class's identifier
-> [value] -- ^ A list of superclasses
@ -173,6 +176,8 @@ instance ( Monad m
kvPair k = pure . injValue . Value.KVPair k
null = pure . injValue $ Value.Null
asPair k
| Just (Value.KVPair k v) <- prjValue k = pure (k, v)
| 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
namespace _ _ = pure Type.Unit
null = pure Type.Null
scopedEnvironment _ = pure mempty

View File

@ -22,6 +22,7 @@ data Type
| Array [Type] -- ^ Arrays. Note that this is heterogenous.
| Hash [(Type, Type)] -- ^ Heterogenous key-value maps.
| 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)
-- TODO: À la carte representation of types.
@ -30,6 +31,8 @@ data Type
-- | Unify two 'Type's.
unify :: MonadFail m => Type -> Type -> m Type
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.
unify (Var _) b = pure b
unify a (Var _) = pure a

View File

@ -25,6 +25,7 @@ type ValueConstructors
, Integer
, KVPair
, Namespace
, Null
, Rational
, String
, Symbol
@ -177,6 +178,13 @@ instance Eq1 Hash where liftEq = genericLiftEq
instance Ord1 Hash where liftCompare = genericLiftCompare
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.
type EnvironmentFor v = Environment (LocationFor v) v

View File

@ -284,7 +284,7 @@ instance Evaluatable QualifiedImport where
where
moduleName = freeVariable (subterm from)
renames importedEnv
| null xs = fmap prepend (Env.names importedEnv)
| Prologue.null xs = fmap prepend (Env.names importedEnv)
| otherwise = xs
prefix = freeVariable (subterm alias)
prepend n = (n, prefix <> n)
@ -307,7 +307,7 @@ instance Evaluatable Import where
where
moduleName = freeVariable (subterm from)
renamed importedEnv
| null xs = importedEnv
| Prologue.null xs = importedEnv
| otherwise = Env.overwrite xs importedEnv
-- | 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.Scientific (Scientific)
import Diffing.Algorithm
import Prelude hiding (Float, fail)
import Prologue hiding (Set, hash)
import Prelude hiding (Float, fail, null)
import Prologue hiding (Set, hash, null)
import Text.Read (readMaybe)
-- Boolean
@ -169,9 +169,7 @@ instance Eq1 Null where liftEq = genericLiftEq
instance Ord1 Null where liftCompare = genericLiftCompare
instance Show1 Null where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Null
instance Evaluatable Null
instance Evaluatable Null where eval = const null
newtype Symbol a = Symbol { symbolContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)