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:
parent
acce67fca7
commit
24598e6f60
|
@ -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 #-}
|
||||
|
|
Loading…
Reference in New Issue
Block a user