{-# LANGUAGE TypeFamilies #-}

module Inferno.Infer.Pinned
  ( pinExpr,
    insertHardcodedModule,
    insertBuiltinModule,
    openModule,
  )
where

import Control.Monad (foldM, forM, when)
import Control.Monad.Except (MonadError (throwError))
import Control.Monad.State (get, put, runStateT)
import Data.Functor.Foldable (cata)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Inferno.Infer.Error (TypeError (..))
import Inferno.Module.Builtin (builtinModule)
import Inferno.Types.Module (Module (..))
import Inferno.Types.Syntax (Expr (..), ExtIdent (..), Ident (..), ImplExpl (..), Import (..), ModuleName (..), Pat (..), PatF (..), Scoped (..), blockPosition, elementPosition)
import Inferno.Types.Type (Namespace (..))
import Inferno.Types.VersionControl (Pinned (..), VCObjectHash)
import Text.Megaparsec (SourcePos (..))

insertIntoLocalScope ::
  Map Namespace (Pinned a) ->
  Map (Scoped ModuleName) (Map Namespace (Pinned a)) ->
  Map (Scoped ModuleName) (Map Namespace (Pinned a))
insertIntoLocalScope :: forall a.
Map Namespace (Pinned a)
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
insertIntoLocalScope Map Namespace (Pinned a)
m Map (Scoped ModuleName) (Map Namespace (Pinned a))
moduleMap =
  forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Map Namespace (Pinned a)) -> Map Namespace (Pinned a)
addModuleToLocalScope) forall a. Scoped a
LocalScope Map (Scoped ModuleName) (Map Namespace (Pinned a))
moduleMap
  where
    addModuleToLocalScope :: Maybe (Map Namespace (Pinned a)) -> Map Namespace (Pinned a)
addModuleToLocalScope Maybe (Map Namespace (Pinned a))
maybeMap = case Maybe (Map Namespace (Pinned a))
maybeMap of
      Maybe (Map Namespace (Pinned a))
Nothing -> Map Namespace (Pinned a)
m
      Just Map Namespace (Pinned a)
m' -> Map Namespace (Pinned a)
m forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map Namespace (Pinned a)
m'

insertHardcodedModule ::
  ModuleName ->
  Map Namespace (Pinned a) ->
  Map (Scoped ModuleName) (Map Namespace (Pinned a)) ->
  Map (Scoped ModuleName) (Map Namespace (Pinned a))
insertHardcodedModule :: forall a.
ModuleName
-> Map Namespace (Pinned a)
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
insertHardcodedModule ModuleName
modNm Map Namespace (Pinned a)
m Map (Scoped ModuleName) (Map Namespace (Pinned a))
moduleMap =
  forall a.
Map Namespace (Pinned a)
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
insertIntoLocalScope (forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey forall p. Namespace -> p -> Bool
isModuleNamespace Map Namespace (Pinned a)
m) forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall a. a -> Scoped a
Scope ModuleName
modNm) Map Namespace (Pinned a)
m Map (Scoped ModuleName) (Map Namespace (Pinned a))
moduleMap
  where
    isModuleNamespace :: Namespace -> p -> Bool
    isModuleNamespace :: forall p. Namespace -> p -> Bool
isModuleNamespace Namespace
k p
_v = case Namespace
k of
      ModuleNamespace ModuleName
_ -> Bool
True
      Namespace
_ -> Bool
False

insertBuiltinModule ::
  Map (Scoped ModuleName) (Map Namespace (Pinned a)) ->
  Map (Scoped ModuleName) (Map Namespace (Pinned a))
insertBuiltinModule :: forall a.
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
insertBuiltinModule =
  forall a.
ModuleName
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
openModule ModuleName
"Builtin"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ModuleName
-> Map Namespace (Pinned a)
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
insertHardcodedModule ModuleName
"Builtin" (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. VCObjectHash -> Pinned a
Builtin Map Namespace VCObjectHash
builtinTysToHash)
  where
    builtinTysToHash :: Map Namespace VCObjectHash
    Module {moduleObjects :: forall objs. Module objs -> objs
moduleObjects = (Map Namespace VCObjectHash
builtinTysToHash, Map VCObjectHash (TypeMetadata TCScheme)
_, ()
_)} = Module
  (Map Namespace VCObjectHash,
   Map VCObjectHash (TypeMetadata TCScheme), ())
builtinModule

openModule ::
  ModuleName ->
  Map (Scoped ModuleName) (Map Namespace (Pinned a)) ->
  Map (Scoped ModuleName) (Map Namespace (Pinned a))
openModule :: forall a.
ModuleName
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
openModule ModuleName
modNm Map (Scoped ModuleName) (Map Namespace (Pinned a))
moduleMap = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a. a -> Scoped a
Scope ModuleName
modNm) Map (Scoped ModuleName) (Map Namespace (Pinned a))
moduleMap of
  Maybe (Map Namespace (Pinned a))
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"openModule: Module " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show ModuleName
modNm forall a. Semigroup a => a -> a -> a
<> [Char]
" does not exist."
  Just Map Namespace (Pinned a)
m -> forall a.
Map Namespace (Pinned a)
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
insertIntoLocalScope Map Namespace (Pinned a)
m Map (Scoped ModuleName) (Map Namespace (Pinned a))
moduleMap

lookupName ::
  (MonadError [TypeError SourcePos] m, Eq a) =>
  (SourcePos, SourcePos) ->
  Scoped ModuleName ->
  Namespace ->
  Map (Scoped ModuleName) (Map Namespace (Pinned a)) ->
  m (Pinned a)
lookupName :: forall (m :: * -> *) a.
(MonadError [TypeError SourcePos] m, Eq a) =>
(SourcePos, SourcePos)
-> Scoped ModuleName
-> Namespace
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> m (Pinned a)
lookupName (SourcePos, SourcePos)
loc Scoped ModuleName
modNm Namespace
ns Map (Scoped ModuleName) (Map Namespace (Pinned a))
m = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Scoped ModuleName
modNm Map (Scoped ModuleName) (Map Namespace (Pinned a))
m of
  Just Map Namespace (Pinned a)
m' -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Namespace
ns Map Namespace (Pinned a)
m' of
    Just Pinned a
r -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Pinned a
r
    Maybe (Pinned a)
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a.
Scoped ModuleName
-> Either VCObjectHash Namespace -> Location a -> TypeError a
UnboundNameInNamespace Scoped ModuleName
modNm (forall a b. b -> Either a b
Right Namespace
ns) (SourcePos, SourcePos)
loc]
  Maybe (Map Namespace (Pinned a))
Nothing -> case Scoped ModuleName
modNm of
    Scope ModuleName
nm -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a. ModuleName -> Location a -> TypeError a
ModuleDoesNotExist ModuleName
nm (SourcePos, SourcePos)
loc]
    Scoped ModuleName
LocalScope -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a.
Scoped ModuleName
-> Either VCObjectHash Namespace -> Location a -> TypeError a
UnboundNameInNamespace Scoped ModuleName
modNm (forall a b. b -> Either a b
Right Namespace
ns) (SourcePos, SourcePos)
loc]

pinPat :: (MonadError [TypeError SourcePos] m, Eq a) => Map (Scoped ModuleName) (Map Namespace (Pinned a)) -> Pat h SourcePos -> m (Pat (Pinned a) SourcePos)
pinPat :: forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Pat h SourcePos -> m (Pat (Pinned a) SourcePos)
pinPat Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Pat h SourcePos
pat =
  let patPos :: (SourcePos, SourcePos)
patPos = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Pat h SourcePos
pat
   in case Pat h SourcePos
pat of
        PVar SourcePos
p Maybe Ident
i -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> Maybe Ident -> Pat hash pos
PVar SourcePos
p Maybe Ident
i
        PEnum SourcePos
p h
_ Scoped ModuleName
modNm Ident
x -> do
          Pinned a
hash <- forall (m :: * -> *) a.
(MonadError [TypeError SourcePos] m, Eq a) =>
(SourcePos, SourcePos)
-> Scoped ModuleName
-> Namespace
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> m (Pinned a)
lookupName (SourcePos, SourcePos)
patPos Scoped ModuleName
modNm (Ident -> Namespace
EnumNamespace Ident
x) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Pat hash pos
PEnum SourcePos
p Pinned a
hash Scoped ModuleName
modNm Ident
x
        PLit SourcePos
p Lit
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> Lit -> Pat hash pos
PLit SourcePos
p Lit
l
        POne SourcePos
p Pat h SourcePos
e -> forall hash pos. pos -> Pat hash pos -> Pat hash pos
POne SourcePos
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Pat h SourcePos -> m (Pat (Pinned a) SourcePos)
pinPat Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Pat h SourcePos
e
        PEmpty SourcePos
p -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> Pat hash pos
PEmpty SourcePos
p
        PTuple SourcePos
p1 TList (Pat h SourcePos, Maybe SourcePos)
es SourcePos
p2 -> do
          TList (Pat (Pinned a) SourcePos, Maybe SourcePos)
es' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Pat h SourcePos
e, Maybe SourcePos
p3) -> (,Maybe SourcePos
p3) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Pat h SourcePos -> m (Pat (Pinned a) SourcePos)
pinPat Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Pat h SourcePos
e) TList (Pat h SourcePos, Maybe SourcePos)
es
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> TList (Pat hash pos, Maybe pos) -> pos -> Pat hash pos
PTuple SourcePos
p1 TList (Pat (Pinned a) SourcePos, Maybe SourcePos)
es' SourcePos
p2
        PCommentAbove Comment SourcePos
c Pat h SourcePos
e -> forall hash pos. Comment pos -> Pat hash pos -> Pat hash pos
PCommentAbove Comment SourcePos
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Pat h SourcePos -> m (Pat (Pinned a) SourcePos)
pinPat Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Pat h SourcePos
e
        PCommentAfter Pat h SourcePos
e Comment SourcePos
c -> (\Pat (Pinned a) SourcePos
e' -> forall hash pos. Pat hash pos -> Comment pos -> Pat hash pos
PCommentAfter Pat (Pinned a) SourcePos
e' Comment SourcePos
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Pat h SourcePos -> m (Pat (Pinned a) SourcePos)
pinPat Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Pat h SourcePos
e
        PCommentBelow Pat h SourcePos
e Comment SourcePos
c -> (\Pat (Pinned a) SourcePos
e' -> forall hash pos. Pat hash pos -> Comment pos -> Pat hash pos
PCommentBelow Pat (Pinned a) SourcePos
e' Comment SourcePos
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Pat h SourcePos -> m (Pat (Pinned a) SourcePos)
pinPat Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Pat h SourcePos
e

-- pinExpr ::
--   (MonadError [TypeError SourcePos] m, Eq a) =>
--   Map ModuleName (Map Namespace (Pinned a)) ->
--   Expr h SourcePos ->
--   m (Expr (Pinned a) SourcePos)
-- pinExpr nameMap = pinExpr nameMapWithBuiltin
--   where
--     Module {moduleObjects = (builtinTysToHash, _, _)} = builtinModule

--     nameMapWithBuiltin =
--       let moduleNames = Map.filterWithKey isModNs $ Map.unions $ Map.elems nameMap
--        in Map.insert LocalScope (Map.map Builtin builtinTysToHash `Map.union` moduleNames) $
--             Map.mapKeysMonotonic Scope $ Map.insert "Builtin" (Map.map Builtin builtinTysToHash) nameMap

patVars :: Pat hash pos -> [Ident]
patVars :: forall hash pos. Pat hash pos -> [Ident]
patVars Pat hash pos
p =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Pat hash pos
p forall a b. (a -> b) -> a -> b
$
    \case
      PVarF pos
_ (Just Ident
v) -> [Ident
v]
      PatF hash pos [Ident]
rest -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. [a] -> [a] -> [a]
(++) [] PatF hash pos [Ident]
rest

isModNs :: Namespace -> p -> Bool
isModNs :: forall p. Namespace -> p -> Bool
isModNs Namespace
k p
_v = case Namespace
k of
  ModuleNamespace ModuleName
_ -> Bool
True
  Namespace
_ -> Bool
False

pinExpr :: (MonadError [TypeError SourcePos] m, Eq a) => Map (Scoped ModuleName) (Map Namespace (Pinned a)) -> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr :: forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
expr =
  let exprPos :: (SourcePos, SourcePos)
exprPos = forall (f :: * -> *).
BlockUtils f =>
f SourcePos -> (SourcePos, SourcePos)
blockPosition Expr h SourcePos
expr
      insertLocal :: Ident
-> Map (Scoped a) (Map Namespace (Pinned a))
-> Map (Scoped a) (Map Namespace (Pinned a))
insertLocal Ident
k Map (Scoped a) (Map Namespace (Pinned a))
m' = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall {k} {a}.
Ord k =>
k -> a -> Maybe (Map k a) -> Maybe (Map k a)
alterFun (Ident -> Namespace
FunNamespace Ident
k) forall a. Pinned a
Local) forall a. Scoped a
LocalScope Map (Scoped a) (Map Namespace (Pinned a))
m'
      alterFun :: k -> a -> Maybe (Map k a) -> Maybe (Map k a)
alterFun k
k a
v = \case
        Just Map k a
m' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k a
v Map k a
m'
        Maybe (Map k a)
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton k
k a
v
   in case Expr h SourcePos
expr of
        Lit SourcePos
p Lit
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> Lit -> Expr hash pos
Lit SourcePos
p Lit
l
        Var SourcePos
p h
_hash Scoped ModuleName
modNm (Impl ExtIdent
x) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var SourcePos
p forall a. Pinned a
Local Scoped ModuleName
modNm (ExtIdent -> ImplExpl
Impl ExtIdent
x)
        Var SourcePos
p h
_hash Scoped ModuleName
modNm i :: ImplExpl
i@(Expl (ExtIdent (Left Int
_))) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var SourcePos
p forall a. Pinned a
Local Scoped ModuleName
modNm ImplExpl
i
        Var SourcePos
p h
_hash Scoped ModuleName
modNm i :: ImplExpl
i@(Expl (ExtIdent (Right Text
x))) -> do
          Pinned a
hash <- forall (m :: * -> *) a.
(MonadError [TypeError SourcePos] m, Eq a) =>
(SourcePos, SourcePos)
-> Scoped ModuleName
-> Namespace
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> m (Pinned a)
lookupName (SourcePos, SourcePos)
exprPos Scoped ModuleName
modNm (Ident -> Namespace
FunNamespace forall a b. (a -> b) -> a -> b
$ Text -> Ident
Ident Text
x) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> hash -> Scoped ModuleName -> ImplExpl -> Expr hash pos
Var SourcePos
p Pinned a
hash Scoped ModuleName
modNm ImplExpl
i
        OpVar SourcePos
p h
_hash Scoped ModuleName
modNm Ident
x -> do
          Pinned a
hash <- forall (m :: * -> *) a.
(MonadError [TypeError SourcePos] m, Eq a) =>
(SourcePos, SourcePos)
-> Scoped ModuleName
-> Namespace
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> m (Pinned a)
lookupName (SourcePos, SourcePos)
exprPos Scoped ModuleName
modNm (Ident -> Namespace
OpNamespace Ident
x) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Expr hash pos
OpVar SourcePos
p Pinned a
hash Scoped ModuleName
modNm Ident
x
        TypeRep SourcePos
p InfernoType
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> InfernoType -> Expr hash pos
TypeRep SourcePos
p InfernoType
t
        Enum SourcePos
p h
_hash Scoped ModuleName
modNm Ident
x -> do
          Pinned a
hash <- forall (m :: * -> *) a.
(MonadError [TypeError SourcePos] m, Eq a) =>
(SourcePos, SourcePos)
-> Scoped ModuleName
-> Namespace
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> m (Pinned a)
lookupName (SourcePos, SourcePos)
exprPos Scoped ModuleName
modNm (Ident -> Namespace
EnumNamespace Ident
x) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> hash -> Scoped ModuleName -> Ident -> Expr hash pos
Enum SourcePos
p Pinned a
hash Scoped ModuleName
modNm Ident
x
        InterpolatedString SourcePos
p1 SomeIStr (SourcePos, Expr h SourcePos, SourcePos)
xs SourcePos
p2 -> do
          SomeIStr (SourcePos, Expr (Pinned a) SourcePos, SourcePos)
xs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(SourcePos
p3, Expr h SourcePos
e, SourcePos
p4) -> (\Expr (Pinned a) SourcePos
e' -> (SourcePos
p3, Expr (Pinned a) SourcePos
e', SourcePos
p4)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e) SomeIStr (SourcePos, Expr h SourcePos, SourcePos)
xs
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> SomeIStr (pos, Expr hash pos, pos) -> pos -> Expr hash pos
InterpolatedString SourcePos
p1 SomeIStr (SourcePos, Expr (Pinned a) SourcePos, SourcePos)
xs' SourcePos
p2
        Array SourcePos
p1 [(Expr h SourcePos, Maybe SourcePos)]
es SourcePos
p2 -> do
          [(Expr (Pinned a) SourcePos, Maybe SourcePos)]
es' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Expr h SourcePos
e, Maybe SourcePos
p3) -> (,Maybe SourcePos
p3) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e) [(Expr h SourcePos, Maybe SourcePos)]
es
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> [(Expr hash pos, Maybe pos)] -> pos -> Expr hash pos
Array SourcePos
p1 [(Expr (Pinned a) SourcePos, Maybe SourcePos)]
es' SourcePos
p2
        ArrayComp SourcePos
p1 Expr h SourcePos
e SourcePos
p2 NonEmpty
  (SourcePos, Ident, SourcePos, Expr h SourcePos, Maybe SourcePos)
sels Maybe (SourcePos, Expr h SourcePos)
cond SourcePos
p3 -> do
          (NonEmpty
  (SourcePos, Ident, SourcePos, Expr (Pinned a) SourcePos,
   Maybe SourcePos)
sels', Map (Scoped ModuleName) (Map Namespace (Pinned a))
m') <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Map (Scoped ModuleName) (Map Namespace (Pinned a))
m forall a b. (a -> b) -> a -> b
$
            forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty
  (SourcePos, Ident, SourcePos, Expr h SourcePos, Maybe SourcePos)
sels forall a b. (a -> b) -> a -> b
$ \(SourcePos
p4, Ident
i, SourcePos
p5, Expr h SourcePos
e1, Maybe SourcePos
p6) -> do
              Map (Scoped ModuleName) (Map Namespace (Pinned a))
currentM <- forall s (m :: * -> *). MonadState s m => m s
get
              Expr (Pinned a) SourcePos
e1' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
currentM Expr h SourcePos
e1
              forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall {a} {a}.
Ord a =>
Ident
-> Map (Scoped a) (Map Namespace (Pinned a))
-> Map (Scoped a) (Map Namespace (Pinned a))
insertLocal Ident
i Map (Scoped ModuleName) (Map Namespace (Pinned a))
currentM
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (SourcePos
p4, Ident
i, SourcePos
p5, Expr (Pinned a) SourcePos
e1', Maybe SourcePos
p6)

          Maybe (SourcePos, Expr (Pinned a) SourcePos)
cond' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(SourcePos
p4, Expr h SourcePos
e1) -> (SourcePos
p4,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m' Expr h SourcePos
e1) Maybe (SourcePos, Expr h SourcePos)
cond
          Expr (Pinned a) SourcePos
e' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m' Expr h SourcePos
e
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Ident, pos, Expr hash pos, Maybe pos)
-> Maybe (pos, Expr hash pos)
-> pos
-> Expr hash pos
ArrayComp SourcePos
p1 Expr (Pinned a) SourcePos
e' SourcePos
p2 NonEmpty
  (SourcePos, Ident, SourcePos, Expr (Pinned a) SourcePos,
   Maybe SourcePos)
sels' Maybe (SourcePos, Expr (Pinned a) SourcePos)
cond' SourcePos
p3
        Lam SourcePos
p1 NonEmpty (SourcePos, Maybe ExtIdent)
args SourcePos
p2 Expr h SourcePos
e -> do
          let m' :: Map (Scoped ModuleName) (Map Namespace (Pinned a))
m' =
                forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                  ( \(SourcePos
_, Maybe ExtIdent
mIdent) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m'' -> case Maybe ExtIdent
mIdent of
                      Just (ExtIdent (Right Text
i)) -> forall {a} {a}.
Ord a =>
Ident
-> Map (Scoped a) (Map Namespace (Pinned a))
-> Map (Scoped a) (Map Namespace (Pinned a))
insertLocal (Text -> Ident
Ident Text
i) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m''
                      Maybe ExtIdent
_ -> Map (Scoped ModuleName) (Map Namespace (Pinned a))
m''
                  )
                  Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
                  NonEmpty (SourcePos, Maybe ExtIdent)
args
          forall hash pos.
pos
-> NonEmpty (pos, Maybe ExtIdent)
-> pos
-> Expr hash pos
-> Expr hash pos
Lam SourcePos
p1 NonEmpty (SourcePos, Maybe ExtIdent)
args SourcePos
p2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m' Expr h SourcePos
e
        App Expr h SourcePos
e1 Expr h SourcePos
e2 -> forall hash pos. Expr hash pos -> Expr hash pos -> Expr hash pos
App forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e2
        Let SourcePos
p1 SourcePos
loc x :: ImplExpl
x@(Expl (ExtIdent (Right Text
i))) SourcePos
p2 Expr h SourcePos
e1 SourcePos
p3 Expr h SourcePos
e2 -> do
          Expr (Pinned a) SourcePos
e1' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e1
          Expr (Pinned a) SourcePos
e2' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr (forall {a} {a}.
Ord a =>
Ident
-> Map (Scoped a) (Map Namespace (Pinned a))
-> Map (Scoped a) (Map Namespace (Pinned a))
insertLocal (Text -> Ident
Ident Text
i) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m) Expr h SourcePos
e2
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos
-> pos
-> ImplExpl
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
Let SourcePos
p1 SourcePos
loc ImplExpl
x SourcePos
p2 Expr (Pinned a) SourcePos
e1' SourcePos
p3 Expr (Pinned a) SourcePos
e2'
        Let SourcePos
p1 SourcePos
loc x :: ImplExpl
x@(Expl (ExtIdent (Left Int
_))) SourcePos
p2 Expr h SourcePos
e1 SourcePos
p3 Expr h SourcePos
e2 -> do
          Expr (Pinned a) SourcePos
e1' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e1
          Expr (Pinned a) SourcePos
e2' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e2
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos
-> pos
-> ImplExpl
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
Let SourcePos
p1 SourcePos
loc ImplExpl
x SourcePos
p2 Expr (Pinned a) SourcePos
e1' SourcePos
p3 Expr (Pinned a) SourcePos
e2'
        Let SourcePos
p1 SourcePos
loc (Impl ExtIdent
x) SourcePos
p2 Expr h SourcePos
e1 SourcePos
p3 Expr h SourcePos
e2 -> do
          Expr (Pinned a) SourcePos
e1' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e1
          Expr (Pinned a) SourcePos
e2' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e2
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos
-> pos
-> ImplExpl
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
Let SourcePos
p1 SourcePos
loc (ExtIdent -> ImplExpl
Impl ExtIdent
x) SourcePos
p2 Expr (Pinned a) SourcePos
e1' SourcePos
p3 Expr (Pinned a) SourcePos
e2'
        Op Expr h SourcePos
e1 SourcePos
p1 h
_ (Int, InfixFixity)
meta Scoped ModuleName
modNm Ident
op Expr h SourcePos
e2 -> do
          Pinned a
hash <- forall (m :: * -> *) a.
(MonadError [TypeError SourcePos] m, Eq a) =>
(SourcePos, SourcePos)
-> Scoped ModuleName
-> Namespace
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> m (Pinned a)
lookupName (SourcePos, SourcePos)
exprPos Scoped ModuleName
modNm (Ident -> Namespace
OpNamespace Ident
op) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
          (\Expr (Pinned a) SourcePos
e1' Expr (Pinned a) SourcePos
e2' -> forall hash pos.
Expr hash pos
-> pos
-> hash
-> (Int, InfixFixity)
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
Op Expr (Pinned a) SourcePos
e1' SourcePos
p1 Pinned a
hash (Int, InfixFixity)
meta Scoped ModuleName
modNm Ident
op Expr (Pinned a) SourcePos
e2')
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e2
        PreOp SourcePos
loc h
_ Int
meta Scoped ModuleName
modNm Ident
op Expr h SourcePos
e -> do
          Pinned a
hash <- forall (m :: * -> *) a.
(MonadError [TypeError SourcePos] m, Eq a) =>
(SourcePos, SourcePos)
-> Scoped ModuleName
-> Namespace
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> m (Pinned a)
lookupName (SourcePos, SourcePos)
exprPos Scoped ModuleName
modNm (Ident -> Namespace
FunNamespace Ident
op) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
          forall hash pos.
pos
-> hash
-> Int
-> Scoped ModuleName
-> Ident
-> Expr hash pos
-> Expr hash pos
PreOp SourcePos
loc Pinned a
hash Int
meta Scoped ModuleName
modNm Ident
op forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e
        If SourcePos
p1 Expr h SourcePos
cond SourcePos
p2 Expr h SourcePos
tr SourcePos
p3 Expr h SourcePos
fl ->
          (\Expr (Pinned a) SourcePos
c Expr (Pinned a) SourcePos
t Expr (Pinned a) SourcePos
f -> forall hash pos.
pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> pos
-> Expr hash pos
-> Expr hash pos
If SourcePos
p1 Expr (Pinned a) SourcePos
c SourcePos
p2 Expr (Pinned a) SourcePos
t SourcePos
p3 Expr (Pinned a) SourcePos
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
cond forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
tr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
fl
        Tuple SourcePos
p1 TList (Expr h SourcePos, Maybe SourcePos)
es SourcePos
p2 -> do
          TList (Expr (Pinned a) SourcePos, Maybe SourcePos)
es' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Expr h SourcePos
e, Maybe SourcePos
p3) -> (,Maybe SourcePos
p3) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e) TList (Expr h SourcePos, Maybe SourcePos)
es
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos -> TList (Expr hash pos, Maybe pos) -> pos -> Expr hash pos
Tuple SourcePos
p1 TList (Expr (Pinned a) SourcePos, Maybe SourcePos)
es' SourcePos
p2
        Assert SourcePos
p1 Expr h SourcePos
cond SourcePos
p2 Expr h SourcePos
e ->
          (\Expr (Pinned a) SourcePos
cond' Expr (Pinned a) SourcePos
e' -> forall hash pos.
pos -> Expr hash pos -> pos -> Expr hash pos -> Expr hash pos
Assert SourcePos
p1 Expr (Pinned a) SourcePos
cond' SourcePos
p2 Expr (Pinned a) SourcePos
e')
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
cond forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e
        Empty SourcePos
p -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos. pos -> Expr hash pos
Empty SourcePos
p
        One SourcePos
p Expr h SourcePos
e -> forall hash pos. pos -> Expr hash pos -> Expr hash pos
One SourcePos
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e
        Case SourcePos
p1 Expr h SourcePos
e SourcePos
p2 NonEmpty (SourcePos, Pat h SourcePos, SourcePos, Expr h SourcePos)
patExprs SourcePos
p3 -> do
          Expr (Pinned a) SourcePos
e' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e
          NonEmpty
  (SourcePos, Pat (Pinned a) SourcePos, SourcePos,
   Expr (Pinned a) SourcePos)
patExprs' <-
            forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
              ( \(SourcePos
p4, Pat h SourcePos
pat, SourcePos
p5, Expr h SourcePos
e1) -> do
                  Pat (Pinned a) SourcePos
pat' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Pat h SourcePos -> m (Pat (Pinned a) SourcePos)
pinPat Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Pat h SourcePos
pat
                  let m' :: Map (Scoped ModuleName) (Map Namespace (Pinned a))
m' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}.
Ord a =>
Ident
-> Map (Scoped a) (Map Namespace (Pinned a))
-> Map (Scoped a) (Map Namespace (Pinned a))
insertLocal Map (Scoped ModuleName) (Map Namespace (Pinned a))
m forall a b. (a -> b) -> a -> b
$ forall hash pos. Pat hash pos -> [Ident]
patVars Pat h SourcePos
pat
                  Expr (Pinned a) SourcePos
e1' <- forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m' Expr h SourcePos
e1
                  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (SourcePos
p4, Pat (Pinned a) SourcePos
pat', SourcePos
p5, Expr (Pinned a) SourcePos
e1')
              )
              NonEmpty (SourcePos, Pat h SourcePos, SourcePos, Expr h SourcePos)
patExprs
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall hash pos.
pos
-> Expr hash pos
-> pos
-> NonEmpty (pos, Pat hash pos, pos, Expr hash pos)
-> pos
-> Expr hash pos
Case SourcePos
p1 Expr (Pinned a) SourcePos
e' SourcePos
p2 NonEmpty
  (SourcePos, Pat (Pinned a) SourcePos, SourcePos,
   Expr (Pinned a) SourcePos)
patExprs' SourcePos
p3
        CommentAbove Comment SourcePos
c Expr h SourcePos
e -> forall hash pos. Comment pos -> Expr hash pos -> Expr hash pos
CommentAbove Comment SourcePos
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e
        CommentAfter Expr h SourcePos
e Comment SourcePos
c -> (\Expr (Pinned a) SourcePos
e' -> forall hash pos. Expr hash pos -> Comment pos -> Expr hash pos
CommentAfter Expr (Pinned a) SourcePos
e' Comment SourcePos
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e
        CommentBelow Expr h SourcePos
e Comment SourcePos
c -> (\Expr (Pinned a) SourcePos
e' -> forall hash pos. Expr hash pos -> Comment pos -> Expr hash pos
CommentBelow Expr (Pinned a) SourcePos
e' Comment SourcePos
c) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e
        Bracketed SourcePos
p1 Expr h SourcePos
e SourcePos
p2 -> (\Expr (Pinned a) SourcePos
e' -> forall hash pos. pos -> Expr hash pos -> pos -> Expr hash pos
Bracketed SourcePos
p1 Expr (Pinned a) SourcePos
e' SourcePos
p2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m Expr h SourcePos
e
        RenameModule SourcePos
l1 ModuleName
newNm SourcePos
l2 ModuleName
oldNm SourcePos
l3 Expr h SourcePos
e -> do
          Pinned a
hash <- forall (m :: * -> *) a.
(MonadError [TypeError SourcePos] m, Eq a) =>
(SourcePos, SourcePos)
-> Scoped ModuleName
-> Namespace
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> m (Pinned a)
lookupName (SourcePos, SourcePos)
exprPos forall a. Scoped a
LocalScope (ModuleName -> Namespace
ModuleNamespace ModuleName
oldNm) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. a -> Scoped a
Scope ModuleName
newNm forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map (Scoped ModuleName) (Map Namespace (Pinned a))
m) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a. ModuleName -> Location a -> TypeError a
ModuleNameTaken ModuleName
newNm forall a b. (a -> b) -> a -> b
$ forall a.
ElementPosition a =>
SourcePos -> a -> (SourcePos, SourcePos)
elementPosition SourcePos
l1 ModuleName
newNm]
          case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a. a -> Scoped a
Scope ModuleName
oldNm) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m of
            Maybe (Map Namespace (Pinned a))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a. ModuleName -> Location a -> TypeError a
ModuleDoesNotExist ModuleName
oldNm (SourcePos
l2, SourcePos
l3)]
            Just Map Namespace (Pinned a)
oldNmMod -> do
              let m' :: Map (Scoped ModuleName) (Map Namespace (Pinned a))
m' = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall {k} {a}.
Ord k =>
k -> a -> Maybe (Map k a) -> Maybe (Map k a)
alterFun (ModuleName -> Namespace
ModuleNamespace ModuleName
newNm) Pinned a
hash) forall a. Scoped a
LocalScope forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall a. a -> Scoped a
Scope ModuleName
newNm) Map Namespace (Pinned a)
oldNmMod Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
              forall hash pos.
pos
-> ModuleName
-> pos
-> ModuleName
-> pos
-> Expr hash pos
-> Expr hash pos
RenameModule SourcePos
l1 ModuleName
newNm SourcePos
l2 ModuleName
oldNm SourcePos
l3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr Map (Scoped ModuleName) (Map Namespace (Pinned a))
m' Expr h SourcePos
e
        OpenModule SourcePos
p1 h
_mHash modNm :: ModuleName
modNm@(ModuleName Text
mn) [(Import SourcePos, Maybe SourcePos)]
imports SourcePos
p2 Expr h SourcePos
e -> do
          Pinned a
hash <- forall (m :: * -> *) a.
(MonadError [TypeError SourcePos] m, Eq a) =>
(SourcePos, SourcePos)
-> Scoped ModuleName
-> Namespace
-> Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> m (Pinned a)
lookupName (SourcePos, SourcePos)
exprPos forall a. Scoped a
LocalScope (ModuleName -> Namespace
ModuleNamespace ModuleName
modNm) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m
          let modPos :: (SourcePos, SourcePos)
modPos = forall a.
ElementPosition a =>
SourcePos -> a -> (SourcePos, SourcePos)
elementPosition SourcePos
p1 forall a b. (a -> b) -> a -> b
$ Text -> Ident
Ident Text
mn
          case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a. a -> Scoped a
Scope ModuleName
modNm) Map (Scoped ModuleName) (Map Namespace (Pinned a))
m of
            Maybe (Map Namespace (Pinned a))
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a. ModuleName -> Location a -> TypeError a
ModuleDoesNotExist ModuleName
modNm (SourcePos, SourcePos)
modPos]
            Just Map Namespace (Pinned a)
openMod' -> do
              let openMod :: Map Namespace (Pinned a)
openMod = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Namespace
k Pinned a
v -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall p. Namespace -> p -> Bool
isModNs Namespace
k Pinned a
v) Map Namespace (Pinned a)
openMod'
              let localM :: Map Namespace (Pinned a)
localM = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup forall a. Scoped a
LocalScope Map (Scoped ModuleName) (Map Namespace (Pinned a))
m

              Map Namespace (Pinned a)
checkedImports <- case [(Import SourcePos, Maybe SourcePos)]
imports of
                [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Map Namespace (Pinned a)
openMod
                [(Import SourcePos, Maybe SourcePos)]
_ -> forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Map Namespace (Pinned a)
-> (SourcePos, SourcePos)
-> [(Namespace, Pinned a)]
-> Import SourcePos
-> m [(Namespace, Pinned a)]
collectImports Map Namespace (Pinned a)
openMod (SourcePos, SourcePos)
modPos) [] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Import SourcePos, Maybe SourcePos)]
imports)

              let intersectionWithLocal :: Map Namespace (Pinned a)
intersectionWithLocal = Map Namespace (Pinned a)
localM forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.intersection` Map Namespace (Pinned a)
checkedImports
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Bool
Map.null Map Namespace (Pinned a)
intersectionWithLocal) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a. ModuleName -> Namespace -> Location a -> TypeError a
AmbiguousName ModuleName
modNm Namespace
i (SourcePos, SourcePos)
modPos | Namespace
i <- forall k a. Map k a -> [k]
Map.keys Map Namespace (Pinned a)
checkedImports]

              forall hash pos.
pos
-> hash
-> ModuleName
-> [(Import pos, Maybe pos)]
-> pos
-> Expr hash pos
-> Expr hash pos
OpenModule SourcePos
p1 Pinned a
hash ModuleName
modNm [(Import SourcePos, Maybe SourcePos)]
imports SourcePos
p2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a h.
(MonadError [TypeError SourcePos] m, Eq a) =>
Map (Scoped ModuleName) (Map Namespace (Pinned a))
-> Expr h SourcePos -> m (Expr (Pinned a) SourcePos)
pinExpr (forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union forall a. Scoped a
LocalScope Map Namespace (Pinned a)
checkedImports Map (Scoped ModuleName) (Map Namespace (Pinned a))
m) Expr h SourcePos
e
          where
            collectImports :: Map Namespace (Pinned a)
-> (SourcePos, SourcePos)
-> [(Namespace, Pinned a)]
-> Import SourcePos
-> m [(Namespace, Pinned a)]
collectImports Map Namespace (Pinned a)
openMod (SourcePos, SourcePos)
pos [(Namespace, Pinned a)]
xs = \case
              IVar SourcePos
_ Ident
i -> do
                let k :: Namespace
k = Ident -> Namespace
FunNamespace Ident
i
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Namespace
k forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Namespace (Pinned a)
openMod) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a. ModuleName -> Ident -> Location a -> TypeError a
NameInModuleDoesNotExist ModuleName
modNm Ident
i (SourcePos, SourcePos)
pos]
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Namespace
k, Map Namespace (Pinned a)
openMod forall k a. Ord k => Map k a -> k -> a
Map.! Namespace
k) forall a. a -> [a] -> [a]
: [(Namespace, Pinned a)]
xs
              IOpVar SourcePos
_ Ident
i -> do
                let k :: Namespace
k = Ident -> Namespace
FunNamespace Ident
i
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Namespace
k forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Namespace (Pinned a)
openMod) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a. ModuleName -> Ident -> Location a -> TypeError a
NameInModuleDoesNotExist ModuleName
modNm Ident
i (SourcePos, SourcePos)
pos]
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Namespace
k, Map Namespace (Pinned a)
openMod forall k a. Ord k => Map k a -> k -> a
Map.! Namespace
k) forall a. a -> [a] -> [a]
: [(Namespace, Pinned a)]
xs
              IEnum SourcePos
_ SourcePos
_ Ident
i -> do
                let k :: Namespace
k = Ident -> Namespace
TypeNamespace Ident
i
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Namespace
k forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Namespace (Pinned a)
openMod) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [forall a. ModuleName -> Ident -> Location a -> TypeError a
NameInModuleDoesNotExist ModuleName
modNm Ident
i (SourcePos, SourcePos)
pos]
                let enumHash :: Pinned a
enumHash = Map Namespace (Pinned a)
openMod forall k a. Ord k => Map k a -> k -> a
Map.! Namespace
k
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                  (forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\Pinned a
h -> Pinned a
h forall a. Eq a => a -> a -> Bool
== Pinned a
enumHash) Map Namespace (Pinned a)
openMod) forall a. [a] -> [a] -> [a]
++ [(Namespace, Pinned a)]
xs
              ICommentAbove Comment SourcePos
_ Import SourcePos
x' -> Map Namespace (Pinned a)
-> (SourcePos, SourcePos)
-> [(Namespace, Pinned a)]
-> Import SourcePos
-> m [(Namespace, Pinned a)]
collectImports Map Namespace (Pinned a)
openMod (SourcePos, SourcePos)
pos [(Namespace, Pinned a)]
xs Import SourcePos
x'
              ICommentAfter Import SourcePos
x' Comment SourcePos
_ -> Map Namespace (Pinned a)
-> (SourcePos, SourcePos)
-> [(Namespace, Pinned a)]
-> Import SourcePos
-> m [(Namespace, Pinned a)]
collectImports Map Namespace (Pinned a)
openMod (SourcePos, SourcePos)
pos [(Namespace, Pinned a)]
xs Import SourcePos
x'
              ICommentBelow Import SourcePos
x' Comment SourcePos
_ -> Map Namespace (Pinned a)
-> (SourcePos, SourcePos)
-> [(Namespace, Pinned a)]
-> Import SourcePos
-> m [(Namespace, Pinned a)]
collectImports Map Namespace (Pinned a)
openMod (SourcePos, SourcePos)
pos [(Namespace, Pinned a)]
xs Import SourcePos
x'