Revert "Improve efficiency of Context implementation"

The old implementation produces better error messages because it preserves the
original order in which variables were bound.  For example, if you wrote:

    λ(a : Type) → λ(x : a) → y

... under the `Map`-based implementation, that would give the following
out-of-order `Context` when displaying the error message:

    Context:
    x : a
    a : Type

... but with the old list-based implementation, the correct order is presented:

    Context:
    a : Type
    x : a
This commit is contained in:
Gabriel Gonzalez 2016-11-01 09:09:15 -07:00
parent acce67fca7
commit 24598e6f60

View File

@ -13,16 +13,9 @@ module Dhall.Context (
, toList
) where
import Data.Map (Map)
import Data.Monoid ((<>))
import Data.Sequence (Seq, (<|))
import Data.Text.Lazy (Text)
import Prelude hiding (lookup)
import qualified Data.Foldable
import qualified Data.Map
import qualified Data.Sequence
{-| A @(Context a)@ associates `Text` labels with values of type @a@
The `Context` is used for type-checking when @(a = Expr X)@
@ -35,37 +28,34 @@ import qualified Data.Sequence
have multiple occurrences of the same key and you can query for the @n@th
occurrence of a given key.
-}
newtype Context a = Context { getContext :: Map Text (Seq a) }
newtype Context a = Context { getContext :: [(Text, a)] }
deriving (Functor)
-- | An empty context with no key-value pairs
empty :: Context a
empty = Context Data.Map.empty
empty = Context []
-- | Add a key-value pair to the `Context`
insert :: Text -> a -> Context a -> Context a
insert k v (Context kvs) =
Context (Data.Map.insertWith (<>) k (Data.Sequence.singleton v) kvs)
insert k v (Context kvs) = Context ((k, v) : kvs)
{-# INLINABLE insert #-}
{-| Look up a key by name and index
> lookup _ _ empty = Nothing
> lookup k 0 (insert k v c) = Just v
> lookup k n (insert k _ c) = lookup k (n - 1) c -- 1 <= n
> lookup k n (insert j _ c) = lookup k n c -- k /= j
> lookup k n (insert k v c) = lookup k (n - 1) c -- 1 <= n
> lookup k n (insert j v c) = lookup k n c -- k /= j
-}
lookup :: Text -> Integer -> Context a -> Maybe a
lookup k n (Context kvs) = do
vs <- Data.Map.lookup k kvs
lookupSeq (fromIntegral n) vs
where
-- Replace this `Data.Sequence.lookup` once that's available on Stackage LTS
lookupSeq :: Int -> Seq a -> Maybe a
lookupSeq n s =
if n < Data.Sequence.length s
then Just (Data.Sequence.index s n)
else Nothing
lookup _ !_ (Context [] ) =
Nothing
lookup x !n (Context ((k, v):kvs)) =
if x == k
then if n == 0
then Just v
else lookup x (n - 1) (Context kvs)
else lookup x n (Context kvs)
{-# INLINABLE lookup #-}
{-| Return all key-value associations as a list
@ -74,8 +64,5 @@ lookup k n (Context kvs) = do
> toList (insert k v ctx) = (k, v) : toList ctx
-}
toList :: Context a -> [(Text, a)]
toList (Context kvs) = do
(k, vs) <- Data.Map.toList kvs
v <- Data.Foldable.toList vs
return (k, v)
toList = getContext
{-# INLINABLE toList #-}