Add a Show instance for Val (#1344)

Since Val contains functions, its Show instance cannot be
derived in the usual way without exposing a non-standard Show
instance for (Val a -> Val a). Instead, we rely on the user to
provide a fitting instance, e.g. by importing Text.Show.Functions.
This commit is contained in:
Simon Jakobi 2019-09-26 17:58:51 +02:00 committed by mergify[bot]
parent f825dd18d9
commit 72bf46b600

View File

@ -1,12 +1,16 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -O #-}
@ -81,6 +85,8 @@ data Environment a
| Skip !(Environment a) {-# UNPACK #-} !Text
| Extend !(Environment a) {-# UNPACK #-} !Text (Val a)
deriving instance (Show a, Show (Val a -> Val a)) => Show (Environment a)
errorMsg :: String
errorMsg = unlines
[ _ERROR <> ": Compiler bug "
@ -98,8 +104,13 @@ errorMsg = unlines
data Closure a = Closure !Text !(Environment a) !(Expr Void a)
deriving instance (Show a, Show (Val a -> Val a)) => Show (Closure a)
data VChunks a = VChunks ![(Text, Val a)] !Text
deriving instance (Show a, Show (Val a -> Val a)) => Show (VChunks a)
instance Semigroup (VChunks a) where
VChunks xys z <> VChunks [] z' = VChunks xys (z <> z')
VChunks xys z <> VChunks ((x', y'):xys') z' = VChunks (xys ++ (z <> x', y'):xys') z'
@ -135,6 +146,8 @@ data HLamInfo a
-- this information in case the @Natural/subtract@ ends up not being fully
-- saturated, in which case we need to recover the unsaturated built-in
deriving instance (Show a, Show (Val a -> Val a)) => Show (HLamInfo a)
pattern VPrim :: (Val a -> Val a) -> Val a
pattern VPrim f = VHLam Prim f
@ -221,6 +234,9 @@ data Val a
| VEquivalent !(Val a) !(Val a)
| VEmbed a
-- | For use with "Text.Show.Functions".
deriving instance (Show a, Show (Val a -> Val a)) => Show (Val a)
(~>) :: Val a -> Val a -> Val a
(~>) a b = VHPi "_" a (\_ -> b)
{-# INLINE (~>) #-}