From 7cd0558266e312a2661141c869e787ee9d02d486 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 26 Mar 2018 12:01:09 -0400
Subject: [PATCH] Evaluate nil/null literals.

---
 src/Control/Abstract/Value.hs  | 6 ++++++
 src/Data/Abstract/Type.hs      | 3 +++
 src/Data/Abstract/Value.hs     | 8 ++++++++
 src/Data/Syntax/Declaration.hs | 4 ++--
 src/Data/Syntax/Literal.hs     | 8 +++-----
 5 files changed, 22 insertions(+), 7 deletions(-)

diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index 46b230015..53d8e094a 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -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
 
diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs
index c89f8148b..3872240f9 100644
--- a/src/Data/Abstract/Type.hs
+++ b/src/Data/Abstract/Type.hs
@@ -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
diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs
index 43b5cb526..95871fc8f 100644
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@@ -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
 
diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs
index 5104e479b..eceb537c8 100644
--- a/src/Data/Syntax/Declaration.hs
+++ b/src/Data/Syntax/Declaration.hs
@@ -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).
diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs
index 1fb1adfda..a437429ab 100644
--- a/src/Data/Syntax/Literal.hs
+++ b/src/Data/Syntax/Literal.hs
@@ -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)