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:
parent
066fc7cb79
commit
7cd0558266
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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).
|
||||||
|
@ -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)
|
||||||
|
Loading…
Reference in New Issue
Block a user