{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
module Cryptol.Parser.NoPat (RemovePatterns(..),Error(..)) where
import Cryptol.Parser.AST
import Cryptol.Parser.Position(Range(..),emptyRange,start,at)
import Cryptol.Parser.Names (namesP)
import Cryptol.Utils.PP
import Cryptol.Utils.Panic(panic)
import MonadLib hiding (mapM)
import Data.Maybe(maybeToList)
import qualified Data.Map as Map
import GHC.Generics (Generic)
import Control.DeepSeq
import Prelude ()
import Prelude.Compat
class RemovePatterns t where
removePatterns :: t -> (t, [Error])
instance RemovePatterns (Program PName) where
removePatterns :: Program PName -> (Program PName, [Error])
removePatterns p :: Program PName
p = NoPatM (Program PName) -> (Program PName, [Error])
forall a. NoPatM a -> (a, [Error])
runNoPatM (Program PName -> NoPatM (Program PName)
noPatProg Program PName
p)
instance RemovePatterns (Expr PName) where
removePatterns :: Expr PName -> (Expr PName, [Error])
removePatterns e :: Expr PName
e = NoPatM (Expr PName) -> (Expr PName, [Error])
forall a. NoPatM a -> (a, [Error])
runNoPatM (Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e)
instance RemovePatterns (Module PName) where
removePatterns :: Module PName -> (Module PName, [Error])
removePatterns m :: Module PName
m = NoPatM (Module PName) -> (Module PName, [Error])
forall a. NoPatM a -> (a, [Error])
runNoPatM (Module PName -> NoPatM (Module PName)
noPatModule Module PName
m)
instance RemovePatterns [Decl PName] where
removePatterns :: [Decl PName] -> ([Decl PName], [Error])
removePatterns ds :: [Decl PName]
ds = NoPatM [Decl PName] -> ([Decl PName], [Error])
forall a. NoPatM a -> (a, [Error])
runNoPatM ([Decl PName] -> NoPatM [Decl PName]
noPatDs [Decl PName]
ds)
simpleBind :: Located PName -> Expr PName -> Bind PName
simpleBind :: Located PName -> Expr PName -> Bind PName
simpleBind x :: Located PName
x e :: Expr PName
e = Bind :: forall name.
Located name
-> [Pattern name]
-> Located (BindDef name)
-> Maybe (Schema name)
-> Bool
-> Maybe Fixity
-> [Pragma]
-> Bool
-> Maybe String
-> Bind name
Bind { bName :: Located PName
bName = Located PName
x, bParams :: [Pattern PName]
bParams = []
, bDef :: Located (BindDef PName)
bDef = Expr PName -> Located (BindDef PName) -> Located (BindDef PName)
forall l t. (HasLoc l, AddLoc t) => l -> t -> t
at Expr PName
e (Range -> BindDef PName -> Located (BindDef PName)
forall a. Range -> a -> Located a
Located Range
emptyRange (Expr PName -> BindDef PName
forall name. Expr name -> BindDef name
DExpr Expr PName
e))
, bSignature :: Maybe (Schema PName)
bSignature = Maybe (Schema PName)
forall a. Maybe a
Nothing, bPragmas :: [Pragma]
bPragmas = []
, bMono :: Bool
bMono = Bool
True, bInfix :: Bool
bInfix = Bool
False, bFixity :: Maybe Fixity
bFixity = Maybe Fixity
forall a. Maybe a
Nothing
, bDoc :: Maybe String
bDoc = Maybe String
forall a. Maybe a
Nothing
}
sel :: Pattern PName -> PName -> Selector -> Bind PName
sel :: Pattern PName -> PName -> Selector -> Bind PName
sel p :: Pattern PName
p x :: PName
x s :: Selector
s = let (a :: Located PName
a,ts :: [Type PName]
ts) = Pattern PName -> (Located PName, [Type PName])
splitSimpleP Pattern PName
p
in Located PName -> Expr PName -> Bind PName
simpleBind Located PName
a ((Expr PName -> Type PName -> Expr PName)
-> Expr PName -> [Type PName] -> Expr PName
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Expr PName -> Type PName -> Expr PName
forall n. Expr n -> Type n -> Expr n
ETyped (Expr PName -> Selector -> Expr PName
forall n. Expr n -> Selector -> Expr n
ESel (PName -> Expr PName
forall n. n -> Expr n
EVar PName
x) Selector
s) [Type PName]
ts)
noPat :: Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat :: Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat pat :: Pattern PName
pat =
case Pattern PName
pat of
PVar x :: Located PName
x -> (Pattern PName, [Bind PName])
-> NoPatM (Pattern PName, [Bind PName])
forall (m :: * -> *) a. Monad m => a -> m a
return (Located PName -> Pattern PName
forall n. Located n -> Pattern n
PVar Located PName
x, [])
PWild ->
do PName
x <- NoPatM PName
newName
Range
r <- NoPatM Range
getRange
(Pattern PName, [Bind PName])
-> NoPatM (Pattern PName, [Bind PName])
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> PName -> Pattern PName
forall n. Range -> n -> Pattern n
pVar Range
r PName
x, [])
PTuple ps :: [Pattern PName]
ps ->
do (as :: [Pattern PName]
as,dss :: [[Bind PName]]
dss) <- [(Pattern PName, [Bind PName])]
-> ([Pattern PName], [[Bind PName]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Pattern PName, [Bind PName])]
-> ([Pattern PName], [[Bind PName]]))
-> NoPatM [(Pattern PName, [Bind PName])]
-> NoPatM ([Pattern PName], [[Bind PName]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Pattern PName -> NoPatM (Pattern PName, [Bind PName]))
-> [Pattern PName] -> NoPatM [(Pattern PName, [Bind PName])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat [Pattern PName]
ps
PName
x <- NoPatM PName
newName
Range
r <- NoPatM Range
getRange
let len :: Int
len = [Pattern PName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern PName]
ps
ty :: Type n
ty = [Type n] -> Type n
forall n. [Type n] -> Type n
TTuple (Int -> Type n -> [Type n]
forall a. Int -> a -> [a]
replicate Int
len Type n
forall n. Type n
TWild)
getN :: Pattern PName -> Int -> Bind PName
getN a :: Pattern PName
a n :: Int
n = Pattern PName -> PName -> Selector -> Bind PName
sel Pattern PName
a PName
x (Int -> Maybe Int -> Selector
TupleSel Int
n (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
len))
(Pattern PName, [Bind PName])
-> NoPatM (Pattern PName, [Bind PName])
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> PName -> Type PName -> Pattern PName
forall n. Range -> n -> Type n -> Pattern n
pTy Range
r PName
x Type PName
forall n. Type n
ty, (Pattern PName -> Int -> Bind PName)
-> [Pattern PName] -> [Int] -> [Bind PName]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Pattern PName -> Int -> Bind PName
getN [Pattern PName]
as [0..] [Bind PName] -> [Bind PName] -> [Bind PName]
forall a. [a] -> [a] -> [a]
++ [[Bind PName]] -> [Bind PName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bind PName]]
dss)
PList [] ->
do PName
x <- NoPatM PName
newName
Range
r <- NoPatM Range
getRange
(Pattern PName, [Bind PName])
-> NoPatM (Pattern PName, [Bind PName])
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> PName -> Type PName -> Pattern PName
forall n. Range -> n -> Type n -> Pattern n
pTy Range
r PName
x (Type PName -> Type PName -> Type PName
forall n. Type n -> Type n -> Type n
TSeq (Integer -> Type PName
forall n. Integer -> Type n
TNum 0) Type PName
forall n. Type n
TWild), [])
PList ps :: [Pattern PName]
ps ->
do (as :: [Pattern PName]
as,dss :: [[Bind PName]]
dss) <- [(Pattern PName, [Bind PName])]
-> ([Pattern PName], [[Bind PName]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Pattern PName, [Bind PName])]
-> ([Pattern PName], [[Bind PName]]))
-> NoPatM [(Pattern PName, [Bind PName])]
-> NoPatM ([Pattern PName], [[Bind PName]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Pattern PName -> NoPatM (Pattern PName, [Bind PName]))
-> [Pattern PName] -> NoPatM [(Pattern PName, [Bind PName])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat [Pattern PName]
ps
PName
x <- NoPatM PName
newName
Range
r <- NoPatM Range
getRange
let len :: Int
len = [Pattern PName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern PName]
ps
ty :: Type n
ty = Type n -> Type n -> Type n
forall n. Type n -> Type n -> Type n
TSeq (Integer -> Type n
forall n. Integer -> Type n
TNum (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
len)) Type n
forall n. Type n
TWild
getN :: Pattern PName -> Int -> Bind PName
getN a :: Pattern PName
a n :: Int
n = Pattern PName -> PName -> Selector -> Bind PName
sel Pattern PName
a PName
x (Int -> Maybe Int -> Selector
ListSel Int
n (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
len))
(Pattern PName, [Bind PName])
-> NoPatM (Pattern PName, [Bind PName])
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> PName -> Type PName -> Pattern PName
forall n. Range -> n -> Type n -> Pattern n
pTy Range
r PName
x Type PName
forall n. Type n
ty, (Pattern PName -> Int -> Bind PName)
-> [Pattern PName] -> [Int] -> [Bind PName]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Pattern PName -> Int -> Bind PName
getN [Pattern PName]
as [0..] [Bind PName] -> [Bind PName] -> [Bind PName]
forall a. [a] -> [a] -> [a]
++ [[Bind PName]] -> [Bind PName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bind PName]]
dss)
PRecord fs :: [Named (Pattern PName)]
fs ->
do (as :: [Pattern PName]
as,dss :: [[Bind PName]]
dss) <- [(Pattern PName, [Bind PName])]
-> ([Pattern PName], [[Bind PName]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Pattern PName, [Bind PName])]
-> ([Pattern PName], [[Bind PName]]))
-> NoPatM [(Pattern PName, [Bind PName])]
-> NoPatM ([Pattern PName], [[Bind PName]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Named (Pattern PName) -> NoPatM (Pattern PName, [Bind PName]))
-> [Named (Pattern PName)]
-> NoPatM [(Pattern PName, [Bind PName])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat (Pattern PName -> NoPatM (Pattern PName, [Bind PName]))
-> (Named (Pattern PName) -> Pattern PName)
-> Named (Pattern PName)
-> NoPatM (Pattern PName, [Bind PName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named (Pattern PName) -> Pattern PName
forall a. Named a -> a
value) [Named (Pattern PName)]
fs
PName
x <- NoPatM PName
newName
Range
r <- NoPatM Range
getRange
let shape :: [Ident]
shape = (Named (Pattern PName) -> Ident)
-> [Named (Pattern PName)] -> [Ident]
forall a b. (a -> b) -> [a] -> [b]
map (Located Ident -> Ident
forall a. Located a -> a
thing (Located Ident -> Ident)
-> (Named (Pattern PName) -> Located Ident)
-> Named (Pattern PName)
-> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Named (Pattern PName) -> Located Ident
forall a. Named a -> Located Ident
name) [Named (Pattern PName)]
fs
ty :: Type n
ty = [Named (Type n)] -> Type n
forall n. [Named (Type n)] -> Type n
TRecord ((Named (Pattern PName) -> Named (Type n))
-> [Named (Pattern PName)] -> [Named (Type n)]
forall a b. (a -> b) -> [a] -> [b]
map ((Pattern PName -> Type n)
-> Named (Pattern PName) -> Named (Type n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\_ -> Type n
forall n. Type n
TWild)) [Named (Pattern PName)]
fs)
getN :: Pattern PName -> Ident -> Bind PName
getN a :: Pattern PName
a n :: Ident
n = Pattern PName -> PName -> Selector -> Bind PName
sel Pattern PName
a PName
x (Ident -> Maybe [Ident] -> Selector
RecordSel Ident
n ([Ident] -> Maybe [Ident]
forall a. a -> Maybe a
Just [Ident]
shape))
(Pattern PName, [Bind PName])
-> NoPatM (Pattern PName, [Bind PName])
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> PName -> Type PName -> Pattern PName
forall n. Range -> n -> Type n -> Pattern n
pTy Range
r PName
x Type PName
forall n. Type n
ty, (Pattern PName -> Ident -> Bind PName)
-> [Pattern PName] -> [Ident] -> [Bind PName]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Pattern PName -> Ident -> Bind PName
getN [Pattern PName]
as [Ident]
shape [Bind PName] -> [Bind PName] -> [Bind PName]
forall a. [a] -> [a] -> [a]
++ [[Bind PName]] -> [Bind PName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bind PName]]
dss)
PTyped p :: Pattern PName
p t :: Type PName
t ->
do (a :: Pattern PName
a,ds :: [Bind PName]
ds) <- Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat Pattern PName
p
(Pattern PName, [Bind PName])
-> NoPatM (Pattern PName, [Bind PName])
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern PName -> Type PName -> Pattern PName
forall n. Pattern n -> Type n -> Pattern n
PTyped Pattern PName
a Type PName
t, [Bind PName]
ds)
PSplit p1 :: Pattern PName
p1 p2 :: Pattern PName
p2 ->
do (a1 :: Pattern PName
a1,ds1 :: [Bind PName]
ds1) <- Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat Pattern PName
p1
(a2 :: Pattern PName
a2,ds2 :: [Bind PName]
ds2) <- Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat Pattern PName
p2
PName
x <- NoPatM PName
newName
PName
tmp <- NoPatM PName
newName
Range
r <- NoPatM Range
getRange
let bTmp :: Bind PName
bTmp = Located PName -> Expr PName -> Bind PName
simpleBind (Range -> PName -> Located PName
forall a. Range -> a -> Located a
Located Range
r PName
tmp) (Expr PName -> Expr PName
forall n. Expr n -> Expr n
ESplit (PName -> Expr PName
forall n. n -> Expr n
EVar PName
x))
b1 :: Bind PName
b1 = Pattern PName -> PName -> Selector -> Bind PName
sel Pattern PName
a1 PName
tmp (Int -> Maybe Int -> Selector
TupleSel 0 (Int -> Maybe Int
forall a. a -> Maybe a
Just 2))
b2 :: Bind PName
b2 = Pattern PName -> PName -> Selector -> Bind PName
sel Pattern PName
a2 PName
tmp (Int -> Maybe Int -> Selector
TupleSel 1 (Int -> Maybe Int
forall a. a -> Maybe a
Just 2))
(Pattern PName, [Bind PName])
-> NoPatM (Pattern PName, [Bind PName])
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> PName -> Pattern PName
forall n. Range -> n -> Pattern n
pVar Range
r PName
x, Bind PName
bTmp Bind PName -> [Bind PName] -> [Bind PName]
forall a. a -> [a] -> [a]
: Bind PName
b1 Bind PName -> [Bind PName] -> [Bind PName]
forall a. a -> [a] -> [a]
: Bind PName
b2 Bind PName -> [Bind PName] -> [Bind PName]
forall a. a -> [a] -> [a]
: [Bind PName]
ds1 [Bind PName] -> [Bind PName] -> [Bind PName]
forall a. [a] -> [a] -> [a]
++ [Bind PName]
ds2)
PLocated p :: Pattern PName
p r1 :: Range
r1 -> Range
-> NoPatM (Pattern PName, [Bind PName])
-> NoPatM (Pattern PName, [Bind PName])
forall a. Range -> NoPatM a -> NoPatM a
inRange Range
r1 (Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat Pattern PName
p)
where
pVar :: Range -> n -> Pattern n
pVar r :: Range
r x :: n
x = Located n -> Pattern n
forall n. Located n -> Pattern n
PVar (Range -> n -> Located n
forall a. Range -> a -> Located a
Located Range
r n
x)
pTy :: Range -> n -> Type n -> Pattern n
pTy r :: Range
r x :: n
x t :: Type n
t = Pattern n -> Type n -> Pattern n
forall n. Pattern n -> Type n -> Pattern n
PTyped (Located n -> Pattern n
forall n. Located n -> Pattern n
PVar (Range -> n -> Located n
forall a. Range -> a -> Located a
Located Range
r n
x)) Type n
t
splitSimpleP :: Pattern PName -> (Located PName, [Type PName])
splitSimpleP :: Pattern PName -> (Located PName, [Type PName])
splitSimpleP (PVar x :: Located PName
x) = (Located PName
x, [])
splitSimpleP (PTyped p :: Pattern PName
p t :: Type PName
t) = let (x :: Located PName
x,ts :: [Type PName]
ts) = Pattern PName -> (Located PName, [Type PName])
splitSimpleP Pattern PName
p
in (Located PName
x, Type PName
tType PName -> [Type PName] -> [Type PName]
forall a. a -> [a] -> [a]
:[Type PName]
ts)
splitSimpleP p :: Pattern PName
p = String -> [String] -> (Located PName, [Type PName])
forall a. HasCallStack => String -> [String] -> a
panic "splitSimpleP"
[ "Non-simple pattern", Pattern PName -> String
forall a. Show a => a -> String
show Pattern PName
p ]
noPatE :: Expr PName -> NoPatM (Expr PName)
noPatE :: Expr PName -> NoPatM (Expr PName)
noPatE expr :: Expr PName
expr =
case Expr PName
expr of
EVar {} -> Expr PName -> NoPatM (Expr PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr PName
expr
ELit {} -> Expr PName -> NoPatM (Expr PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr PName
expr
ENeg e :: Expr PName
e -> Expr PName -> Expr PName
forall n. Expr n -> Expr n
ENeg (Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e
EComplement e :: Expr PName
e -> Expr PName -> Expr PName
forall n. Expr n -> Expr n
EComplement (Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e
EGenerate e :: Expr PName
e -> Expr PName -> Expr PName
forall n. Expr n -> Expr n
EGenerate (Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e
ETuple es :: [Expr PName]
es -> [Expr PName] -> Expr PName
forall n. [Expr n] -> Expr n
ETuple ([Expr PName] -> Expr PName)
-> NoPatM [Expr PName] -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr PName -> NoPatM (Expr PName))
-> [Expr PName] -> NoPatM [Expr PName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr PName -> NoPatM (Expr PName)
noPatE [Expr PName]
es
ERecord es :: [Named (Expr PName)]
es -> [Named (Expr PName)] -> Expr PName
forall n. [Named (Expr n)] -> Expr n
ERecord ([Named (Expr PName)] -> Expr PName)
-> NoPatM [Named (Expr PName)] -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Named (Expr PName) -> NoPatM (Named (Expr PName)))
-> [Named (Expr PName)] -> NoPatM [Named (Expr PName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Named (Expr PName) -> NoPatM (Named (Expr PName))
noPatF [Named (Expr PName)]
es
ESel e :: Expr PName
e s :: Selector
s -> Expr PName -> Selector -> Expr PName
forall n. Expr n -> Selector -> Expr n
ESel (Expr PName -> Selector -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Selector -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e NoPatM (Selector -> Expr PName)
-> NoPatM Selector -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> NoPatM Selector
forall (m :: * -> *) a. Monad m => a -> m a
return Selector
s
EUpd mb :: Maybe (Expr PName)
mb fs :: [UpdField PName]
fs -> Maybe (Expr PName) -> [UpdField PName] -> Expr PName
forall n. Maybe (Expr n) -> [UpdField n] -> Expr n
EUpd (Maybe (Expr PName) -> [UpdField PName] -> Expr PName)
-> NoPatM (Maybe (Expr PName))
-> NoPatM ([UpdField PName] -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr PName -> NoPatM (Expr PName))
-> Maybe (Expr PName) -> NoPatM (Maybe (Expr PName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> NoPatM (Expr PName)
noPatE Maybe (Expr PName)
mb NoPatM ([UpdField PName] -> Expr PName)
-> NoPatM [UpdField PName] -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UpdField PName -> NoPatM (UpdField PName))
-> [UpdField PName] -> NoPatM [UpdField PName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse UpdField PName -> NoPatM (UpdField PName)
noPatUF [UpdField PName]
fs
EList es :: [Expr PName]
es -> [Expr PName] -> Expr PName
forall n. [Expr n] -> Expr n
EList ([Expr PName] -> Expr PName)
-> NoPatM [Expr PName] -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr PName -> NoPatM (Expr PName))
-> [Expr PName] -> NoPatM [Expr PName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr PName -> NoPatM (Expr PName)
noPatE [Expr PName]
es
EFromTo {} -> Expr PName -> NoPatM (Expr PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr PName
expr
EInfFrom e :: Expr PName
e e' :: Maybe (Expr PName)
e' -> Expr PName -> Maybe (Expr PName) -> Expr PName
forall n. Expr n -> Maybe (Expr n) -> Expr n
EInfFrom (Expr PName -> Maybe (Expr PName) -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Maybe (Expr PName) -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e NoPatM (Maybe (Expr PName) -> Expr PName)
-> NoPatM (Maybe (Expr PName)) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr PName -> NoPatM (Expr PName))
-> Maybe (Expr PName) -> NoPatM (Maybe (Expr PName))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr PName -> NoPatM (Expr PName)
noPatE Maybe (Expr PName)
e'
EComp e :: Expr PName
e mss :: [[Match PName]]
mss -> Expr PName -> [[Match PName]] -> Expr PName
forall n. Expr n -> [[Match n]] -> Expr n
EComp (Expr PName -> [[Match PName]] -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM ([[Match PName]] -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e NoPatM ([[Match PName]] -> Expr PName)
-> NoPatM [[Match PName]] -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Match PName] -> NoPatM [Match PName])
-> [[Match PName]] -> NoPatM [[Match PName]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Match PName] -> NoPatM [Match PName]
noPatArm [[Match PName]]
mss
EApp e1 :: Expr PName
e1 e2 :: Expr PName
e2 -> Expr PName -> Expr PName -> Expr PName
forall n. Expr n -> Expr n -> Expr n
EApp (Expr PName -> Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e1 NoPatM (Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e2
EAppT e :: Expr PName
e ts :: [TypeInst PName]
ts -> Expr PName -> [TypeInst PName] -> Expr PName
forall n. Expr n -> [TypeInst n] -> Expr n
EAppT (Expr PName -> [TypeInst PName] -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM ([TypeInst PName] -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e NoPatM ([TypeInst PName] -> Expr PName)
-> NoPatM [TypeInst PName] -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TypeInst PName] -> NoPatM [TypeInst PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [TypeInst PName]
ts
EIf e1 :: Expr PName
e1 e2 :: Expr PName
e2 e3 :: Expr PName
e3 -> Expr PName -> Expr PName -> Expr PName -> Expr PName
forall n. Expr n -> Expr n -> Expr n -> Expr n
EIf (Expr PName -> Expr PName -> Expr PName -> Expr PName)
-> NoPatM (Expr PName)
-> NoPatM (Expr PName -> Expr PName -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e1 NoPatM (Expr PName -> Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName -> Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e2 NoPatM (Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e3
EWhere e :: Expr PName
e ds :: [Decl PName]
ds -> Expr PName -> [Decl PName] -> Expr PName
forall n. Expr n -> [Decl n] -> Expr n
EWhere (Expr PName -> [Decl PName] -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM ([Decl PName] -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e NoPatM ([Decl PName] -> Expr PName)
-> NoPatM [Decl PName] -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Decl PName] -> NoPatM [Decl PName]
noPatDs [Decl PName]
ds
ETyped e :: Expr PName
e t :: Type PName
t -> Expr PName -> Type PName -> Expr PName
forall n. Expr n -> Type n -> Expr n
ETyped (Expr PName -> Type PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Type PName -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e NoPatM (Type PName -> Expr PName)
-> NoPatM (Type PName) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type PName -> NoPatM (Type PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Type PName
t
ETypeVal {} -> Expr PName -> NoPatM (Expr PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr PName
expr
EFun ps :: [Pattern PName]
ps e :: Expr PName
e -> do (ps1 :: [Pattern PName]
ps1,e1 :: Expr PName
e1) <- [Pattern PName]
-> Expr PName -> NoPatM ([Pattern PName], Expr PName)
noPatFun [Pattern PName]
ps Expr PName
e
Expr PName -> NoPatM (Expr PName)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pattern PName] -> Expr PName -> Expr PName
forall n. [Pattern n] -> Expr n -> Expr n
EFun [Pattern PName]
ps1 Expr PName
e1)
ELocated e :: Expr PName
e r1 :: Range
r1 -> Expr PName -> Range -> Expr PName
forall n. Expr n -> Range -> Expr n
ELocated (Expr PName -> Range -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Range -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range -> NoPatM (Expr PName) -> NoPatM (Expr PName)
forall a. Range -> NoPatM a -> NoPatM a
inRange Range
r1 (Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e) NoPatM (Range -> Expr PName) -> NoPatM Range -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range -> NoPatM Range
forall (m :: * -> *) a. Monad m => a -> m a
return Range
r1
ESplit e :: Expr PName
e -> Expr PName -> Expr PName
forall n. Expr n -> Expr n
ESplit (Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e
EParens e :: Expr PName
e -> Expr PName -> Expr PName
forall n. Expr n -> Expr n
EParens (Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e
EInfix x :: Expr PName
x y :: Located PName
y f :: Fixity
f z :: Expr PName
z-> Expr PName -> Located PName -> Fixity -> Expr PName -> Expr PName
forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
EInfix (Expr PName -> Located PName -> Fixity -> Expr PName -> Expr PName)
-> NoPatM (Expr PName)
-> NoPatM (Located PName -> Fixity -> Expr PName -> Expr PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
x NoPatM (Located PName -> Fixity -> Expr PName -> Expr PName)
-> NoPatM (Located PName)
-> NoPatM (Fixity -> Expr PName -> Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Located PName -> NoPatM (Located PName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Located PName
y NoPatM (Fixity -> Expr PName -> Expr PName)
-> NoPatM Fixity -> NoPatM (Expr PName -> Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fixity -> NoPatM Fixity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Fixity
f NoPatM (Expr PName -> Expr PName)
-> NoPatM (Expr PName) -> NoPatM (Expr PName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
z
where noPatF :: Named (Expr PName) -> NoPatM (Named (Expr PName))
noPatF x :: Named (Expr PName)
x = do Expr PName
e <- Expr PName -> NoPatM (Expr PName)
noPatE (Named (Expr PName) -> Expr PName
forall a. Named a -> a
value Named (Expr PName)
x)
Named (Expr PName) -> NoPatM (Named (Expr PName))
forall (m :: * -> *) a. Monad m => a -> m a
return Named (Expr PName)
x { value :: Expr PName
value = Expr PName
e }
noPatUF :: UpdField PName -> NoPatM (UpdField PName)
noPatUF :: UpdField PName -> NoPatM (UpdField PName)
noPatUF (UpdField h :: UpdHow
h ls :: [Located Selector]
ls e :: Expr PName
e) = UpdHow -> [Located Selector] -> Expr PName -> UpdField PName
forall n. UpdHow -> [Located Selector] -> Expr n -> UpdField n
UpdField UpdHow
h [Located Selector]
ls (Expr PName -> UpdField PName)
-> NoPatM (Expr PName) -> NoPatM (UpdField PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e
noPatFun :: [Pattern PName] -> Expr PName -> NoPatM ([Pattern PName], Expr PName)
noPatFun :: [Pattern PName]
-> Expr PName -> NoPatM ([Pattern PName], Expr PName)
noPatFun ps :: [Pattern PName]
ps e :: Expr PName
e =
do (xs :: [Pattern PName]
xs,bs :: [[Bind PName]]
bs) <- [(Pattern PName, [Bind PName])]
-> ([Pattern PName], [[Bind PName]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Pattern PName, [Bind PName])]
-> ([Pattern PName], [[Bind PName]]))
-> NoPatM [(Pattern PName, [Bind PName])]
-> NoPatM ([Pattern PName], [[Bind PName]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern PName -> NoPatM (Pattern PName, [Bind PName]))
-> [Pattern PName] -> NoPatM [(Pattern PName, [Bind PName])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat [Pattern PName]
ps
Expr PName
e1 <- Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e
let body :: Expr PName
body = case [[Bind PName]] -> [Bind PName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bind PName]]
bs of
[] -> Expr PName
e1
ds :: [Bind PName]
ds -> Expr PName -> [Decl PName] -> Expr PName
forall n. Expr n -> [Decl n] -> Expr n
EWhere Expr PName
e1 ([Decl PName] -> Expr PName) -> [Decl PName] -> Expr PName
forall a b. (a -> b) -> a -> b
$ (Bind PName -> Decl PName) -> [Bind PName] -> [Decl PName]
forall a b. (a -> b) -> [a] -> [b]
map Bind PName -> Decl PName
forall name. Bind name -> Decl name
DBind [Bind PName]
ds
([Pattern PName], Expr PName)
-> NoPatM ([Pattern PName], Expr PName)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Pattern PName]
xs, Expr PName
body)
noPatArm :: [Match PName] -> NoPatM [Match PName]
noPatArm :: [Match PName] -> NoPatM [Match PName]
noPatArm ms :: [Match PName]
ms = [[Match PName]] -> [Match PName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Match PName]] -> [Match PName])
-> NoPatM [[Match PName]] -> NoPatM [Match PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Match PName -> NoPatM [Match PName])
-> [Match PName] -> NoPatM [[Match PName]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Match PName -> NoPatM [Match PName]
noPatM [Match PName]
ms
noPatM :: Match PName -> NoPatM [Match PName]
noPatM :: Match PName -> NoPatM [Match PName]
noPatM (Match p :: Pattern PName
p e :: Expr PName
e) =
do (x :: Pattern PName
x,bs :: [Bind PName]
bs) <- Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat Pattern PName
p
Expr PName
e1 <- Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e
[Match PName] -> NoPatM [Match PName]
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern PName -> Expr PName -> Match PName
forall name. Pattern name -> Expr name -> Match name
Match Pattern PName
x Expr PName
e1 Match PName -> [Match PName] -> [Match PName]
forall a. a -> [a] -> [a]
: (Bind PName -> Match PName) -> [Bind PName] -> [Match PName]
forall a b. (a -> b) -> [a] -> [b]
map Bind PName -> Match PName
forall name. Bind name -> Match name
MatchLet [Bind PName]
bs)
noPatM (MatchLet b :: Bind PName
b) = (Match PName -> [Match PName]
forall (m :: * -> *) a. Monad m => a -> m a
return (Match PName -> [Match PName])
-> (Bind PName -> Match PName) -> Bind PName -> [Match PName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bind PName -> Match PName
forall name. Bind name -> Match name
MatchLet) (Bind PName -> [Match PName])
-> NoPatM (Bind PName) -> NoPatM [Match PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bind PName -> NoPatM (Bind PName)
noMatchB Bind PName
b
noMatchB :: Bind PName -> NoPatM (Bind PName)
noMatchB :: Bind PName -> NoPatM (Bind PName)
noMatchB b :: Bind PName
b =
case Located (BindDef PName) -> BindDef PName
forall a. Located a -> a
thing (Bind PName -> Located (BindDef PName)
forall name. Bind name -> Located (BindDef name)
bDef Bind PName
b) of
DPrim | [Pattern PName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Bind PName -> [Pattern PName]
forall name. Bind name -> [Pattern name]
bParams Bind PName
b) -> Bind PName -> NoPatM (Bind PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Bind PName
b
| Bool
otherwise -> String -> [String] -> NoPatM (Bind PName)
forall a. HasCallStack => String -> [String] -> a
panic "NoPat" [ "noMatchB: primitive with params"
, Bind PName -> String
forall a. Show a => a -> String
show Bind PName
b ]
DExpr e :: Expr PName
e ->
do (ps :: [Pattern PName]
ps,e' :: Expr PName
e') <- [Pattern PName]
-> Expr PName -> NoPatM ([Pattern PName], Expr PName)
noPatFun (Bind PName -> [Pattern PName]
forall name. Bind name -> [Pattern name]
bParams Bind PName
b) Expr PName
e
Bind PName -> NoPatM (Bind PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Bind PName
b { bParams :: [Pattern PName]
bParams = [Pattern PName]
ps, bDef :: Located (BindDef PName)
bDef = Expr PName -> BindDef PName
forall name. Expr name -> BindDef name
DExpr Expr PName
e' BindDef PName -> Located (BindDef PName) -> Located (BindDef PName)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bind PName -> Located (BindDef PName)
forall name. Bind name -> Located (BindDef name)
bDef Bind PName
b }
noMatchD :: Decl PName -> NoPatM [Decl PName]
noMatchD :: Decl PName -> NoPatM [Decl PName]
noMatchD decl :: Decl PName
decl =
case Decl PName
decl of
DSignature {} -> [Decl PName] -> NoPatM [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl PName
decl]
DPragma {} -> [Decl PName] -> NoPatM [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl PName
decl]
DFixity{} -> [Decl PName] -> NoPatM [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl PName
decl]
DBind b :: Bind PName
b -> do Bind PName
b1 <- Bind PName -> NoPatM (Bind PName)
noMatchB Bind PName
b
[Decl PName] -> NoPatM [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bind PName -> Decl PName
forall name. Bind name -> Decl name
DBind Bind PName
b1]
DPatBind p :: Pattern PName
p e :: Expr PName
e -> do (p' :: Pattern PName
p',bs :: [Bind PName]
bs) <- Pattern PName -> NoPatM (Pattern PName, [Bind PName])
noPat Pattern PName
p
let (x :: Located PName
x,ts :: [Type PName]
ts) = Pattern PName -> (Located PName, [Type PName])
splitSimpleP Pattern PName
p'
Expr PName
e1 <- Expr PName -> NoPatM (Expr PName)
noPatE Expr PName
e
let e2 :: Expr PName
e2 = (Expr PName -> Type PName -> Expr PName)
-> Expr PName -> [Type PName] -> Expr PName
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Expr PName -> Type PName -> Expr PName
forall n. Expr n -> Type n -> Expr n
ETyped Expr PName
e1 [Type PName]
ts
[Decl PName] -> NoPatM [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Decl PName] -> NoPatM [Decl PName])
-> [Decl PName] -> NoPatM [Decl PName]
forall a b. (a -> b) -> a -> b
$ Bind PName -> Decl PName
forall name. Bind name -> Decl name
DBind Bind :: forall name.
Located name
-> [Pattern name]
-> Located (BindDef name)
-> Maybe (Schema name)
-> Bool
-> Maybe Fixity
-> [Pragma]
-> Bool
-> Maybe String
-> Bind name
Bind { bName :: Located PName
bName = Located PName
x
, bParams :: [Pattern PName]
bParams = []
, bDef :: Located (BindDef PName)
bDef = Expr PName -> Located (BindDef PName) -> Located (BindDef PName)
forall l t. (HasLoc l, AddLoc t) => l -> t -> t
at Expr PName
e (Range -> BindDef PName -> Located (BindDef PName)
forall a. Range -> a -> Located a
Located Range
emptyRange (Expr PName -> BindDef PName
forall name. Expr name -> BindDef name
DExpr Expr PName
e2))
, bSignature :: Maybe (Schema PName)
bSignature = Maybe (Schema PName)
forall a. Maybe a
Nothing
, bPragmas :: [Pragma]
bPragmas = []
, bMono :: Bool
bMono = Bool
False
, bInfix :: Bool
bInfix = Bool
False
, bFixity :: Maybe Fixity
bFixity = Maybe Fixity
forall a. Maybe a
Nothing
, bDoc :: Maybe String
bDoc = Maybe String
forall a. Maybe a
Nothing
} Decl PName -> [Decl PName] -> [Decl PName]
forall a. a -> [a] -> [a]
: (Bind PName -> Decl PName) -> [Bind PName] -> [Decl PName]
forall a b. (a -> b) -> [a] -> [b]
map Bind PName -> Decl PName
forall name. Bind name -> Decl name
DBind [Bind PName]
bs
DType {} -> [Decl PName] -> NoPatM [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl PName
decl]
DProp {} -> [Decl PName] -> NoPatM [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl PName
decl]
DLocated d :: Decl PName
d r1 :: Range
r1 -> do [Decl PName]
bs <- Range -> NoPatM [Decl PName] -> NoPatM [Decl PName]
forall a. Range -> NoPatM a -> NoPatM a
inRange Range
r1 (NoPatM [Decl PName] -> NoPatM [Decl PName])
-> NoPatM [Decl PName] -> NoPatM [Decl PName]
forall a b. (a -> b) -> a -> b
$ Decl PName -> NoPatM [Decl PName]
noMatchD Decl PName
d
[Decl PName] -> NoPatM [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Decl PName] -> NoPatM [Decl PName])
-> [Decl PName] -> NoPatM [Decl PName]
forall a b. (a -> b) -> a -> b
$ (Decl PName -> Decl PName) -> [Decl PName] -> [Decl PName]
forall a b. (a -> b) -> [a] -> [b]
map (Decl PName -> Range -> Decl PName
forall name. Decl name -> Range -> Decl name
`DLocated` Range
r1) [Decl PName]
bs
noPatDs :: [Decl PName] -> NoPatM [Decl PName]
noPatDs :: [Decl PName] -> NoPatM [Decl PName]
noPatDs ds :: [Decl PName]
ds =
do [Decl PName]
ds1 <- [[Decl PName]] -> [Decl PName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Decl PName]] -> [Decl PName])
-> NoPatM [[Decl PName]] -> NoPatM [Decl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decl PName -> NoPatM [Decl PName])
-> [Decl PName] -> NoPatM [[Decl PName]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Decl PName -> NoPatM [Decl PName]
noMatchD [Decl PName]
ds
let fixes :: Map PName [Located Fixity]
fixes = ([Located Fixity] -> [Located Fixity] -> [Located Fixity])
-> [(PName, [Located Fixity])] -> Map PName [Located Fixity]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Located Fixity] -> [Located Fixity] -> [Located Fixity]
forall a. [a] -> [a] -> [a]
(++) ([(PName, [Located Fixity])] -> Map PName [Located Fixity])
-> [(PName, [Located Fixity])] -> Map PName [Located Fixity]
forall a b. (a -> b) -> a -> b
$ (Decl PName -> [(PName, [Located Fixity])])
-> [Decl PName] -> [(PName, [Located Fixity])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl PName -> [(PName, [Located Fixity])]
toFixity [Decl PName]
ds1
amap :: AnnotMap
amap = AnnotMap :: Map PName [Located Pragma]
-> Map PName [Located (Schema PName)]
-> Map PName [Located Fixity]
-> Map PName [Located Fixity]
-> Map PName [Located String]
-> AnnotMap
AnnotMap
{ annPragmas :: Map PName [Located Pragma]
annPragmas = ([Located Pragma] -> [Located Pragma] -> [Located Pragma])
-> [(PName, [Located Pragma])] -> Map PName [Located Pragma]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Located Pragma] -> [Located Pragma] -> [Located Pragma]
forall a. [a] -> [a] -> [a]
(++) ([(PName, [Located Pragma])] -> Map PName [Located Pragma])
-> [(PName, [Located Pragma])] -> Map PName [Located Pragma]
forall a b. (a -> b) -> a -> b
$ (Decl PName -> [(PName, [Located Pragma])])
-> [Decl PName] -> [(PName, [Located Pragma])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl PName -> [(PName, [Located Pragma])]
toPragma [Decl PName]
ds1
, annSigs :: Map PName [Located (Schema PName)]
annSigs = ([Located (Schema PName)]
-> [Located (Schema PName)] -> [Located (Schema PName)])
-> [(PName, [Located (Schema PName)])]
-> Map PName [Located (Schema PName)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Located (Schema PName)]
-> [Located (Schema PName)] -> [Located (Schema PName)]
forall a. [a] -> [a] -> [a]
(++) ([(PName, [Located (Schema PName)])]
-> Map PName [Located (Schema PName)])
-> [(PName, [Located (Schema PName)])]
-> Map PName [Located (Schema PName)]
forall a b. (a -> b) -> a -> b
$ (Decl PName -> [(PName, [Located (Schema PName)])])
-> [Decl PName] -> [(PName, [Located (Schema PName)])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl PName -> [(PName, [Located (Schema PName)])]
toSig [Decl PName]
ds1
, annValueFs :: Map PName [Located Fixity]
annValueFs = Map PName [Located Fixity]
fixes
, annTypeFs :: Map PName [Located Fixity]
annTypeFs = Map PName [Located Fixity]
fixes
, annDocs :: Map PName [Located String]
annDocs = Map PName [Located String]
forall k a. Map k a
Map.empty
}
(ds2 :: [Decl PName]
ds2, AnnotMap { .. }) <- AnnotMap
-> StateT AnnotMap NoPatM [Decl PName]
-> NoPatM ([Decl PName], AnnotMap)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT AnnotMap
amap (Annotates [Decl PName]
annotDs [Decl PName]
ds1)
[(PName, [Located Pragma])]
-> ((PName, [Located Pragma]) -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map PName [Located Pragma] -> [(PName, [Located Pragma])]
forall k a. Map k a -> [(k, a)]
Map.toList Map PName [Located Pragma]
annPragmas) (((PName, [Located Pragma]) -> NoPatM ()) -> NoPatM ())
-> ((PName, [Located Pragma]) -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \(n :: PName
n,ps :: [Located Pragma]
ps) ->
[Located Pragma] -> (Located Pragma -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Located Pragma]
ps ((Located Pragma -> NoPatM ()) -> NoPatM ())
-> (Located Pragma -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \p :: Located Pragma
p -> Error -> NoPatM ()
recordError (Error -> NoPatM ()) -> Error -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ Located PName -> Pragma -> Error
PragmaNoBind (Located Pragma
p { thing :: PName
thing = PName
n }) (Located Pragma -> Pragma
forall a. Located a -> a
thing Located Pragma
p)
[(PName, [Located (Schema PName)])]
-> ((PName, [Located (Schema PName)]) -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map PName [Located (Schema PName)]
-> [(PName, [Located (Schema PName)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map PName [Located (Schema PName)]
annSigs) (((PName, [Located (Schema PName)]) -> NoPatM ()) -> NoPatM ())
-> ((PName, [Located (Schema PName)]) -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \(n :: PName
n,ss :: [Located (Schema PName)]
ss) ->
do Maybe (Schema PName)
_ <- PName -> [Located (Schema PName)] -> NoPatM (Maybe (Schema PName))
checkSigs PName
n [Located (Schema PName)]
ss
[Located (Schema PName)]
-> (Located (Schema PName) -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Located (Schema PName)]
ss ((Located (Schema PName) -> NoPatM ()) -> NoPatM ())
-> (Located (Schema PName) -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \s :: Located (Schema PName)
s -> Error -> NoPatM ()
recordError (Error -> NoPatM ()) -> Error -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ Located PName -> Schema PName -> Error
SignatureNoBind (Located (Schema PName)
s { thing :: PName
thing = PName
n })
(Located (Schema PName) -> Schema PName
forall a. Located a -> a
thing Located (Schema PName)
s)
[(PName, [Located Fixity])]
-> ((PName, [Located Fixity]) -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map PName [Located Fixity] -> [(PName, [Located Fixity])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map PName [Located Fixity]
-> Map PName [Located Fixity] -> Map PName [Located Fixity]
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map PName [Located Fixity]
annValueFs Map PName [Located Fixity]
annTypeFs)) (((PName, [Located Fixity]) -> NoPatM ()) -> NoPatM ())
-> ((PName, [Located Fixity]) -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \(n :: PName
n,fs :: [Located Fixity]
fs) ->
[Located Fixity] -> (Located Fixity -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Located Fixity]
fs ((Located Fixity -> NoPatM ()) -> NoPatM ())
-> (Located Fixity -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \f :: Located Fixity
f -> Error -> NoPatM ()
recordError (Error -> NoPatM ()) -> Error -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ Located PName -> Error
FixityNoBind Located Fixity
f { thing :: PName
thing = PName
n }
[Decl PName] -> NoPatM [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [Decl PName]
ds2
noPatTopDs :: [TopDecl PName] -> NoPatM [TopDecl PName]
noPatTopDs :: [TopDecl PName] -> NoPatM [TopDecl PName]
noPatTopDs tds :: [TopDecl PName]
tds =
do [TopDecl PName]
desugared <- [[TopDecl PName]] -> [TopDecl PName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TopDecl PName]] -> [TopDecl PName])
-> NoPatM [[TopDecl PName]] -> NoPatM [TopDecl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TopDecl PName -> NoPatM [TopDecl PName])
-> [TopDecl PName] -> NoPatM [[TopDecl PName]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TopDecl PName -> NoPatM [TopDecl PName]
desugar [TopDecl PName]
tds
let allDecls :: [Decl PName]
allDecls = (TopLevel (Decl PName) -> Decl PName)
-> [TopLevel (Decl PName)] -> [Decl PName]
forall a b. (a -> b) -> [a] -> [b]
map TopLevel (Decl PName) -> Decl PName
forall a. TopLevel a -> a
tlValue ([TopDecl PName] -> [TopLevel (Decl PName)]
forall name. [TopDecl name] -> [TopLevel (Decl name)]
decls [TopDecl PName]
desugared)
fixes :: Map PName [Located Fixity]
fixes = ([Located Fixity] -> [Located Fixity] -> [Located Fixity])
-> [(PName, [Located Fixity])] -> Map PName [Located Fixity]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Located Fixity] -> [Located Fixity] -> [Located Fixity]
forall a. [a] -> [a] -> [a]
(++) ([(PName, [Located Fixity])] -> Map PName [Located Fixity])
-> [(PName, [Located Fixity])] -> Map PName [Located Fixity]
forall a b. (a -> b) -> a -> b
$ (Decl PName -> [(PName, [Located Fixity])])
-> [Decl PName] -> [(PName, [Located Fixity])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl PName -> [(PName, [Located Fixity])]
toFixity [Decl PName]
allDecls
let ann :: AnnotMap
ann = AnnotMap :: Map PName [Located Pragma]
-> Map PName [Located (Schema PName)]
-> Map PName [Located Fixity]
-> Map PName [Located Fixity]
-> Map PName [Located String]
-> AnnotMap
AnnotMap
{ annPragmas :: Map PName [Located Pragma]
annPragmas = ([Located Pragma] -> [Located Pragma] -> [Located Pragma])
-> [(PName, [Located Pragma])] -> Map PName [Located Pragma]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Located Pragma] -> [Located Pragma] -> [Located Pragma]
forall a. [a] -> [a] -> [a]
(++) ([(PName, [Located Pragma])] -> Map PName [Located Pragma])
-> [(PName, [Located Pragma])] -> Map PName [Located Pragma]
forall a b. (a -> b) -> a -> b
$ (Decl PName -> [(PName, [Located Pragma])])
-> [Decl PName] -> [(PName, [Located Pragma])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl PName -> [(PName, [Located Pragma])]
toPragma [Decl PName]
allDecls
, annSigs :: Map PName [Located (Schema PName)]
annSigs = ([Located (Schema PName)]
-> [Located (Schema PName)] -> [Located (Schema PName)])
-> [(PName, [Located (Schema PName)])]
-> Map PName [Located (Schema PName)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Located (Schema PName)]
-> [Located (Schema PName)] -> [Located (Schema PName)]
forall a. [a] -> [a] -> [a]
(++) ([(PName, [Located (Schema PName)])]
-> Map PName [Located (Schema PName)])
-> [(PName, [Located (Schema PName)])]
-> Map PName [Located (Schema PName)]
forall a b. (a -> b) -> a -> b
$ (Decl PName -> [(PName, [Located (Schema PName)])])
-> [Decl PName] -> [(PName, [Located (Schema PName)])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Decl PName -> [(PName, [Located (Schema PName)])]
toSig [Decl PName]
allDecls
, annValueFs :: Map PName [Located Fixity]
annValueFs = Map PName [Located Fixity]
fixes
, annTypeFs :: Map PName [Located Fixity]
annTypeFs = Map PName [Located Fixity]
fixes
, annDocs :: Map PName [Located String]
annDocs = ([Located String] -> [Located String] -> [Located String])
-> [(PName, [Located String])] -> Map PName [Located String]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Located String] -> [Located String] -> [Located String]
forall a. [a] -> [a] -> [a]
(++) ([(PName, [Located String])] -> Map PName [Located String])
-> [(PName, [Located String])] -> Map PName [Located String]
forall a b. (a -> b) -> a -> b
$ (TopLevel (Decl PName) -> [(PName, [Located String])])
-> [TopLevel (Decl PName)] -> [(PName, [Located String])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TopLevel (Decl PName) -> [(PName, [Located String])]
toDocs ([TopLevel (Decl PName)] -> [(PName, [Located String])])
-> [TopLevel (Decl PName)] -> [(PName, [Located String])]
forall a b. (a -> b) -> a -> b
$ [TopDecl PName] -> [TopLevel (Decl PName)]
forall name. [TopDecl name] -> [TopLevel (Decl name)]
decls [TopDecl PName]
tds
}
(tds' :: [TopDecl PName]
tds', AnnotMap { .. }) <- AnnotMap
-> StateT AnnotMap NoPatM [TopDecl PName]
-> NoPatM ([TopDecl PName], AnnotMap)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT AnnotMap
ann (Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
desugared)
[(PName, [Located Pragma])]
-> ((PName, [Located Pragma]) -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map PName [Located Pragma] -> [(PName, [Located Pragma])]
forall k a. Map k a -> [(k, a)]
Map.toList Map PName [Located Pragma]
annPragmas) (((PName, [Located Pragma]) -> NoPatM ()) -> NoPatM ())
-> ((PName, [Located Pragma]) -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \(n :: PName
n,ps :: [Located Pragma]
ps) ->
[Located Pragma] -> (Located Pragma -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Located Pragma]
ps ((Located Pragma -> NoPatM ()) -> NoPatM ())
-> (Located Pragma -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \p :: Located Pragma
p -> Error -> NoPatM ()
recordError (Error -> NoPatM ()) -> Error -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ Located PName -> Pragma -> Error
PragmaNoBind (Located Pragma
p { thing :: PName
thing = PName
n }) (Located Pragma -> Pragma
forall a. Located a -> a
thing Located Pragma
p)
[(PName, [Located (Schema PName)])]
-> ((PName, [Located (Schema PName)]) -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map PName [Located (Schema PName)]
-> [(PName, [Located (Schema PName)])]
forall k a. Map k a -> [(k, a)]
Map.toList Map PName [Located (Schema PName)]
annSigs) (((PName, [Located (Schema PName)]) -> NoPatM ()) -> NoPatM ())
-> ((PName, [Located (Schema PName)]) -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \(n :: PName
n,ss :: [Located (Schema PName)]
ss) ->
do Maybe (Schema PName)
_ <- PName -> [Located (Schema PName)] -> NoPatM (Maybe (Schema PName))
checkSigs PName
n [Located (Schema PName)]
ss
[Located (Schema PName)]
-> (Located (Schema PName) -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Located (Schema PName)]
ss ((Located (Schema PName) -> NoPatM ()) -> NoPatM ())
-> (Located (Schema PName) -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \s :: Located (Schema PName)
s -> Error -> NoPatM ()
recordError (Error -> NoPatM ()) -> Error -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ Located PName -> Schema PName -> Error
SignatureNoBind (Located (Schema PName)
s { thing :: PName
thing = PName
n })
(Located (Schema PName) -> Schema PName
forall a. Located a -> a
thing Located (Schema PName)
s)
[(PName, [Located Fixity])]
-> ((PName, [Located Fixity]) -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map PName [Located Fixity] -> [(PName, [Located Fixity])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map PName [Located Fixity]
-> Map PName [Located Fixity] -> Map PName [Located Fixity]
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map PName [Located Fixity]
annValueFs Map PName [Located Fixity]
annTypeFs)) (((PName, [Located Fixity]) -> NoPatM ()) -> NoPatM ())
-> ((PName, [Located Fixity]) -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \(n :: PName
n,fs :: [Located Fixity]
fs) ->
[Located Fixity] -> (Located Fixity -> NoPatM ()) -> NoPatM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Located Fixity]
fs ((Located Fixity -> NoPatM ()) -> NoPatM ())
-> (Located Fixity -> NoPatM ()) -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ \f :: Located Fixity
f -> Error -> NoPatM ()
recordError (Error -> NoPatM ()) -> Error -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ Located PName -> Error
FixityNoBind Located Fixity
f { thing :: PName
thing = PName
n }
[TopDecl PName] -> NoPatM [TopDecl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [TopDecl PName]
tds'
where
decls :: [TopDecl name] -> [TopLevel (Decl name)]
decls xs :: [TopDecl name]
xs = [ TopLevel (Decl name)
d | Decl d :: TopLevel (Decl name)
d <- [TopDecl name]
xs ]
desugar :: TopDecl PName -> NoPatM [TopDecl PName]
desugar d :: TopDecl PName
d =
case TopDecl PName
d of
Decl tl :: TopLevel (Decl PName)
tl -> do [Decl PName]
ds <- Decl PName -> NoPatM [Decl PName]
noMatchD (TopLevel (Decl PName) -> Decl PName
forall a. TopLevel a -> a
tlValue TopLevel (Decl PName)
tl)
[TopDecl PName] -> NoPatM [TopDecl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [ TopLevel (Decl PName) -> TopDecl PName
forall name. TopLevel (Decl name) -> TopDecl name
Decl TopLevel (Decl PName)
tl { tlValue :: Decl PName
tlValue = Decl PName
d1 } | Decl PName
d1 <- [Decl PName]
ds ]
x :: TopDecl PName
x -> [TopDecl PName] -> NoPatM [TopDecl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return [TopDecl PName
x]
noPatProg :: Program PName -> NoPatM (Program PName)
noPatProg :: Program PName -> NoPatM (Program PName)
noPatProg (Program topDs :: [TopDecl PName]
topDs) = [TopDecl PName] -> Program PName
forall name. [TopDecl name] -> Program name
Program ([TopDecl PName] -> Program PName)
-> NoPatM [TopDecl PName] -> NoPatM (Program PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TopDecl PName] -> NoPatM [TopDecl PName]
noPatTopDs [TopDecl PName]
topDs
noPatModule :: Module PName -> NoPatM (Module PName)
noPatModule :: Module PName -> NoPatM (Module PName)
noPatModule m :: Module PName
m =
do [TopDecl PName]
ds1 <- [TopDecl PName] -> NoPatM [TopDecl PName]
noPatTopDs (Module PName -> [TopDecl PName]
forall name. Module name -> [TopDecl name]
mDecls Module PName
m)
Module PName -> NoPatM (Module PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Module PName
m { mDecls :: [TopDecl PName]
mDecls = [TopDecl PName]
ds1 }
data AnnotMap = AnnotMap
{ AnnotMap -> Map PName [Located Pragma]
annPragmas :: Map.Map PName [Located Pragma ]
, AnnotMap -> Map PName [Located (Schema PName)]
annSigs :: Map.Map PName [Located (Schema PName)]
, AnnotMap -> Map PName [Located Fixity]
annValueFs :: Map.Map PName [Located Fixity ]
, AnnotMap -> Map PName [Located Fixity]
annTypeFs :: Map.Map PName [Located Fixity ]
, AnnotMap -> Map PName [Located String]
annDocs :: Map.Map PName [Located String ]
}
type Annotates a = a -> StateT AnnotMap NoPatM a
annotTopDs :: Annotates [TopDecl PName]
annotTopDs :: Annotates [TopDecl PName]
annotTopDs tds :: [TopDecl PName]
tds =
case [TopDecl PName]
tds of
d :: TopDecl PName
d : ds :: [TopDecl PName]
ds ->
case TopDecl PName
d of
Decl d1 :: TopLevel (Decl PName)
d1 ->
do Either () (Decl PName)
ignore <- ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
-> StateT AnnotMap NoPatM (Either () (Decl PName))
forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT (Decl PName -> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
annotD (TopLevel (Decl PName) -> Decl PName
forall a. TopLevel a -> a
tlValue TopLevel (Decl PName)
d1))
case Either () (Decl PName)
ignore of
Left _ -> Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
ds
Right d2 :: Decl PName
d2 -> (TopLevel (Decl PName) -> TopDecl PName
forall name. TopLevel (Decl name) -> TopDecl name
Decl (TopLevel (Decl PName)
d1 { tlValue :: Decl PName
tlValue = Decl PName
d2 }) TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
:) ([TopDecl PName] -> [TopDecl PName])
-> StateT AnnotMap NoPatM [TopDecl PName]
-> StateT AnnotMap NoPatM [TopDecl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
ds
DPrimType tl :: TopLevel (PrimType PName)
tl ->
do PrimType PName
pt <- Annotates (PrimType PName)
annotPrimType (TopLevel (PrimType PName) -> PrimType PName
forall a. TopLevel a -> a
tlValue TopLevel (PrimType PName)
tl)
let d1 :: TopDecl PName
d1 = TopLevel (PrimType PName) -> TopDecl PName
forall name. TopLevel (PrimType name) -> TopDecl name
DPrimType TopLevel (PrimType PName)
tl { tlValue :: PrimType PName
tlValue = PrimType PName
pt }
(TopDecl PName
d1 TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
:) ([TopDecl PName] -> [TopDecl PName])
-> StateT AnnotMap NoPatM [TopDecl PName]
-> StateT AnnotMap NoPatM [TopDecl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
ds
DParameterType p :: ParameterType PName
p ->
do ParameterType PName
p1 <- Annotates (ParameterType PName)
annotParameterType ParameterType PName
p
(ParameterType PName -> TopDecl PName
forall name. ParameterType name -> TopDecl name
DParameterType ParameterType PName
p1 TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
:) ([TopDecl PName] -> [TopDecl PName])
-> StateT AnnotMap NoPatM [TopDecl PName]
-> StateT AnnotMap NoPatM [TopDecl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
ds
DParameterConstraint {} -> (TopDecl PName
d TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
:) ([TopDecl PName] -> [TopDecl PName])
-> StateT AnnotMap NoPatM [TopDecl PName]
-> StateT AnnotMap NoPatM [TopDecl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
ds
DParameterFun p :: ParameterFun PName
p ->
do AnnotMap { .. } <- StateT AnnotMap NoPatM AnnotMap
forall (m :: * -> *) i. StateM m i => m i
get
let rm :: p -> p -> Maybe a
rm _ _ = Maybe a
forall a. Maybe a
Nothing
name :: PName
name = Located PName -> PName
forall a. Located a -> a
thing (ParameterFun PName -> Located PName
forall name. ParameterFun name -> Located name
pfName ParameterFun PName
p)
case (PName -> [Located Fixity] -> Maybe [Located Fixity])
-> PName
-> Map PName [Located Fixity]
-> (Maybe [Located Fixity], Map PName [Located Fixity])
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey PName -> [Located Fixity] -> Maybe [Located Fixity]
forall p p a. p -> p -> Maybe a
rm PName
name Map PName [Located Fixity]
annValueFs of
(Nothing,_) -> (TopDecl PName
d TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
:) ([TopDecl PName] -> [TopDecl PName])
-> StateT AnnotMap NoPatM [TopDecl PName]
-> StateT AnnotMap NoPatM [TopDecl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
ds
(Just f :: [Located Fixity]
f,fs1 :: Map PName [Located Fixity]
fs1) ->
do Maybe Fixity
mbF <- NoPatM (Maybe Fixity) -> StateT AnnotMap NoPatM (Maybe Fixity)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (PName -> [Located Fixity] -> NoPatM (Maybe Fixity)
checkFixs PName
name [Located Fixity]
f)
AnnotMap -> StateT AnnotMap NoPatM ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set AnnotMap :: Map PName [Located Pragma]
-> Map PName [Located (Schema PName)]
-> Map PName [Located Fixity]
-> Map PName [Located Fixity]
-> Map PName [Located String]
-> AnnotMap
AnnotMap { annValueFs :: Map PName [Located Fixity]
annValueFs = Map PName [Located Fixity]
fs1, .. }
let p1 :: ParameterFun PName
p1 = ParameterFun PName
p { pfFixity :: Maybe Fixity
pfFixity = Maybe Fixity
mbF }
(ParameterFun PName -> TopDecl PName
forall name. ParameterFun name -> TopDecl name
DParameterFun ParameterFun PName
p1 TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
:) ([TopDecl PName] -> [TopDecl PName])
-> StateT AnnotMap NoPatM [TopDecl PName]
-> StateT AnnotMap NoPatM [TopDecl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
ds
TDNewtype {} -> (TopDecl PName
d TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
:) ([TopDecl PName] -> [TopDecl PName])
-> StateT AnnotMap NoPatM [TopDecl PName]
-> StateT AnnotMap NoPatM [TopDecl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
ds
Include {} -> (TopDecl PName
d TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
forall a. a -> [a] -> [a]
:) ([TopDecl PName] -> [TopDecl PName])
-> StateT AnnotMap NoPatM [TopDecl PName]
-> StateT AnnotMap NoPatM [TopDecl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotates [TopDecl PName]
annotTopDs [TopDecl PName]
ds
[] -> Annotates [TopDecl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return []
annotDs :: Annotates [Decl PName]
annotDs :: Annotates [Decl PName]
annotDs (d :: Decl PName
d : ds :: [Decl PName]
ds) =
do Either () (Decl PName)
ignore <- ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
-> StateT AnnotMap NoPatM (Either () (Decl PName))
forall i (m :: * -> *) a. ExceptionT i m a -> m (Either i a)
runExceptionT (Decl PName -> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
annotD Decl PName
d)
case Either () (Decl PName)
ignore of
Left () -> Annotates [Decl PName]
annotDs [Decl PName]
ds
Right d1 :: Decl PName
d1 -> (Decl PName
d1 Decl PName -> [Decl PName] -> [Decl PName]
forall a. a -> [a] -> [a]
:) ([Decl PName] -> [Decl PName])
-> StateT AnnotMap NoPatM [Decl PName]
-> StateT AnnotMap NoPatM [Decl PName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotates [Decl PName]
annotDs [Decl PName]
ds
annotDs [] = Annotates [Decl PName]
forall (m :: * -> *) a. Monad m => a -> m a
return []
annotD :: Decl PName -> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
annotD :: Decl PName -> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
annotD decl :: Decl PName
decl =
case Decl PName
decl of
DBind b :: Bind PName
b -> Bind PName -> Decl PName
forall name. Bind name -> Decl name
DBind (Bind PName -> Decl PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (Bind PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AnnotMap NoPatM (Bind PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (Bind PName)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (Annotates (Bind PName)
annotB Bind PName
b)
DSignature {} -> () -> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ()
DFixity{} -> () -> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ()
DPragma {} -> () -> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ()
DPatBind {} -> () -> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
forall (m :: * -> *) i a. ExceptionM m i => i -> m a
raise ()
DType tysyn :: TySyn PName
tysyn -> TySyn PName -> Decl PName
forall name. TySyn name -> Decl name
DType (TySyn PName -> Decl PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (TySyn PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AnnotMap NoPatM (TySyn PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (TySyn PName)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (Annotates (TySyn PName)
annotTySyn TySyn PName
tysyn)
DProp propsyn :: PropSyn PName
propsyn -> PropSyn PName -> Decl PName
forall name. PropSyn name -> Decl name
DProp (PropSyn PName -> Decl PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (PropSyn PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AnnotMap NoPatM (PropSyn PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (PropSyn PName)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (Annotates (PropSyn PName)
annotPropSyn PropSyn PName
propsyn)
DLocated d :: Decl PName
d r :: Range
r -> (Decl PName -> Range -> Decl PName
forall name. Decl name -> Range -> Decl name
`DLocated` Range
r) (Decl PName -> Decl PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
-> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decl PName -> ExceptionT () (StateT AnnotMap NoPatM) (Decl PName)
annotD Decl PName
d
annotB :: Annotates (Bind PName)
annotB :: Annotates (Bind PName)
annotB Bind { .. } =
do AnnotMap { .. } <- StateT AnnotMap NoPatM AnnotMap
forall (m :: * -> *) i. StateM m i => m i
get
let name :: PName
name = Located PName -> PName
forall a. Located a -> a
thing Located PName
bName
remove :: p -> p -> Maybe a
remove _ _ = Maybe a
forall a. Maybe a
Nothing
(thisPs :: Maybe [Located Pragma]
thisPs , ps' :: Map PName [Located Pragma]
ps') = (PName -> [Located Pragma] -> Maybe [Located Pragma])
-> PName
-> Map PName [Located Pragma]
-> (Maybe [Located Pragma], Map PName [Located Pragma])
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey PName -> [Located Pragma] -> Maybe [Located Pragma]
forall p p a. p -> p -> Maybe a
remove PName
name Map PName [Located Pragma]
annPragmas
(thisSigs :: Maybe [Located (Schema PName)]
thisSigs , ss' :: Map PName [Located (Schema PName)]
ss') = (PName
-> [Located (Schema PName)] -> Maybe [Located (Schema PName)])
-> PName
-> Map PName [Located (Schema PName)]
-> (Maybe [Located (Schema PName)],
Map PName [Located (Schema PName)])
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey PName -> [Located (Schema PName)] -> Maybe [Located (Schema PName)]
forall p p a. p -> p -> Maybe a
remove PName
name Map PName [Located (Schema PName)]
annSigs
(thisFixes :: Maybe [Located Fixity]
thisFixes , fs' :: Map PName [Located Fixity]
fs') = (PName -> [Located Fixity] -> Maybe [Located Fixity])
-> PName
-> Map PName [Located Fixity]
-> (Maybe [Located Fixity], Map PName [Located Fixity])
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey PName -> [Located Fixity] -> Maybe [Located Fixity]
forall p p a. p -> p -> Maybe a
remove PName
name Map PName [Located Fixity]
annValueFs
(thisDocs :: Maybe [Located String]
thisDocs , ds' :: Map PName [Located String]
ds') = (PName -> [Located String] -> Maybe [Located String])
-> PName
-> Map PName [Located String]
-> (Maybe [Located String], Map PName [Located String])
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey PName -> [Located String] -> Maybe [Located String]
forall p p a. p -> p -> Maybe a
remove PName
name Map PName [Located String]
annDocs
Maybe (Schema PName)
s <- NoPatM (Maybe (Schema PName))
-> StateT AnnotMap NoPatM (Maybe (Schema PName))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (NoPatM (Maybe (Schema PName))
-> StateT AnnotMap NoPatM (Maybe (Schema PName)))
-> NoPatM (Maybe (Schema PName))
-> StateT AnnotMap NoPatM (Maybe (Schema PName))
forall a b. (a -> b) -> a -> b
$ PName -> [Located (Schema PName)] -> NoPatM (Maybe (Schema PName))
checkSigs PName
name ([Located (Schema PName)] -> NoPatM (Maybe (Schema PName)))
-> [Located (Schema PName)] -> NoPatM (Maybe (Schema PName))
forall a b. (a -> b) -> a -> b
$ Maybe [Located (Schema PName)] -> [Located (Schema PName)]
forall a. Maybe [a] -> [a]
jn Maybe [Located (Schema PName)]
thisSigs
Maybe Fixity
f <- NoPatM (Maybe Fixity) -> StateT AnnotMap NoPatM (Maybe Fixity)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (NoPatM (Maybe Fixity) -> StateT AnnotMap NoPatM (Maybe Fixity))
-> NoPatM (Maybe Fixity) -> StateT AnnotMap NoPatM (Maybe Fixity)
forall a b. (a -> b) -> a -> b
$ PName -> [Located Fixity] -> NoPatM (Maybe Fixity)
checkFixs PName
name ([Located Fixity] -> NoPatM (Maybe Fixity))
-> [Located Fixity] -> NoPatM (Maybe Fixity)
forall a b. (a -> b) -> a -> b
$ Maybe [Located Fixity] -> [Located Fixity]
forall a. Maybe [a] -> [a]
jn Maybe [Located Fixity]
thisFixes
Maybe String
d <- NoPatM (Maybe String) -> StateT AnnotMap NoPatM (Maybe String)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (NoPatM (Maybe String) -> StateT AnnotMap NoPatM (Maybe String))
-> NoPatM (Maybe String) -> StateT AnnotMap NoPatM (Maybe String)
forall a b. (a -> b) -> a -> b
$ PName -> [Located String] -> NoPatM (Maybe String)
checkDocs PName
name ([Located String] -> NoPatM (Maybe String))
-> [Located String] -> NoPatM (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe [Located String] -> [Located String]
forall a. Maybe [a] -> [a]
jn Maybe [Located String]
thisDocs
AnnotMap -> StateT AnnotMap NoPatM ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set AnnotMap :: Map PName [Located Pragma]
-> Map PName [Located (Schema PName)]
-> Map PName [Located Fixity]
-> Map PName [Located Fixity]
-> Map PName [Located String]
-> AnnotMap
AnnotMap { annPragmas :: Map PName [Located Pragma]
annPragmas = Map PName [Located Pragma]
ps'
, annSigs :: Map PName [Located (Schema PName)]
annSigs = Map PName [Located (Schema PName)]
ss'
, annValueFs :: Map PName [Located Fixity]
annValueFs = Map PName [Located Fixity]
fs'
, annDocs :: Map PName [Located String]
annDocs = Map PName [Located String]
ds'
, ..
}
Annotates (Bind PName)
forall (m :: * -> *) a. Monad m => a -> m a
return Bind :: forall name.
Located name
-> [Pattern name]
-> Located (BindDef name)
-> Maybe (Schema name)
-> Bool
-> Maybe Fixity
-> [Pragma]
-> Bool
-> Maybe String
-> Bind name
Bind { bSignature :: Maybe (Schema PName)
bSignature = Maybe (Schema PName)
s
, bPragmas :: [Pragma]
bPragmas = (Located Pragma -> Pragma) -> [Located Pragma] -> [Pragma]
forall a b. (a -> b) -> [a] -> [b]
map Located Pragma -> Pragma
forall a. Located a -> a
thing (Maybe [Located Pragma] -> [Located Pragma]
forall a. Maybe [a] -> [a]
jn Maybe [Located Pragma]
thisPs) [Pragma] -> [Pragma] -> [Pragma]
forall a. [a] -> [a] -> [a]
++ [Pragma]
bPragmas
, bFixity :: Maybe Fixity
bFixity = Maybe Fixity
f
, bDoc :: Maybe String
bDoc = Maybe String
d
, ..
}
where jn :: Maybe [a] -> [a]
jn x :: Maybe [a]
x = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Maybe [a] -> [[a]]
forall a. Maybe a -> [a]
maybeToList Maybe [a]
x)
annotTyThing :: PName -> StateT AnnotMap NoPatM (Maybe Fixity)
annotTyThing :: PName -> StateT AnnotMap NoPatM (Maybe Fixity)
annotTyThing name :: PName
name =
do AnnotMap { .. } <- StateT AnnotMap NoPatM AnnotMap
forall (m :: * -> *) i. StateM m i => m i
get
let remove :: p -> p -> Maybe a
remove _ _ = Maybe a
forall a. Maybe a
Nothing
(thisFixes :: Maybe [Located Fixity]
thisFixes, ts' :: Map PName [Located Fixity]
ts') = (PName -> [Located Fixity] -> Maybe [Located Fixity])
-> PName
-> Map PName [Located Fixity]
-> (Maybe [Located Fixity], Map PName [Located Fixity])
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey PName -> [Located Fixity] -> Maybe [Located Fixity]
forall p p a. p -> p -> Maybe a
remove PName
name Map PName [Located Fixity]
annTypeFs
Maybe Fixity
f <- NoPatM (Maybe Fixity) -> StateT AnnotMap NoPatM (Maybe Fixity)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadT t, Monad m) =>
m a -> t m a
lift (NoPatM (Maybe Fixity) -> StateT AnnotMap NoPatM (Maybe Fixity))
-> NoPatM (Maybe Fixity) -> StateT AnnotMap NoPatM (Maybe Fixity)
forall a b. (a -> b) -> a -> b
$ PName -> [Located Fixity] -> NoPatM (Maybe Fixity)
checkFixs PName
name ([Located Fixity] -> NoPatM (Maybe Fixity))
-> [Located Fixity] -> NoPatM (Maybe Fixity)
forall a b. (a -> b) -> a -> b
$ [[Located Fixity]] -> [Located Fixity]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Located Fixity]] -> [Located Fixity])
-> [[Located Fixity]] -> [Located Fixity]
forall a b. (a -> b) -> a -> b
$ Maybe [Located Fixity] -> [[Located Fixity]]
forall a. Maybe a -> [a]
maybeToList Maybe [Located Fixity]
thisFixes
AnnotMap -> StateT AnnotMap NoPatM ()
forall (m :: * -> *) i. StateM m i => i -> m ()
set AnnotMap :: Map PName [Located Pragma]
-> Map PName [Located (Schema PName)]
-> Map PName [Located Fixity]
-> Map PName [Located Fixity]
-> Map PName [Located String]
-> AnnotMap
AnnotMap { annTypeFs :: Map PName [Located Fixity]
annTypeFs = Map PName [Located Fixity]
ts', .. }
Maybe Fixity -> StateT AnnotMap NoPatM (Maybe Fixity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Fixity
f
annotTySyn :: Annotates (TySyn PName)
annotTySyn :: Annotates (TySyn PName)
annotTySyn (TySyn ln :: Located PName
ln _ params :: [TParam PName]
params rhs :: Type PName
rhs) =
do Maybe Fixity
f <- PName -> StateT AnnotMap NoPatM (Maybe Fixity)
annotTyThing (Located PName -> PName
forall a. Located a -> a
thing Located PName
ln)
Annotates (TySyn PName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Located PName
-> Maybe Fixity -> [TParam PName] -> Type PName -> TySyn PName
forall n.
Located n -> Maybe Fixity -> [TParam n] -> Type n -> TySyn n
TySyn Located PName
ln Maybe Fixity
f [TParam PName]
params Type PName
rhs)
annotPropSyn :: Annotates (PropSyn PName)
annotPropSyn :: Annotates (PropSyn PName)
annotPropSyn (PropSyn ln :: Located PName
ln _ params :: [TParam PName]
params rhs :: [Prop PName]
rhs) =
do Maybe Fixity
f <- PName -> StateT AnnotMap NoPatM (Maybe Fixity)
annotTyThing (Located PName -> PName
forall a. Located a -> a
thing Located PName
ln)
Annotates (PropSyn PName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Located PName
-> Maybe Fixity -> [TParam PName] -> [Prop PName] -> PropSyn PName
forall n.
Located n -> Maybe Fixity -> [TParam n] -> [Prop n] -> PropSyn n
PropSyn Located PName
ln Maybe Fixity
f [TParam PName]
params [Prop PName]
rhs)
annotPrimType :: Annotates (PrimType PName)
annotPrimType :: Annotates (PrimType PName)
annotPrimType pt :: PrimType PName
pt =
do Maybe Fixity
f <- PName -> StateT AnnotMap NoPatM (Maybe Fixity)
annotTyThing (Located PName -> PName
forall a. Located a -> a
thing (PrimType PName -> Located PName
forall name. PrimType name -> Located name
primTName PrimType PName
pt))
Annotates (PrimType PName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimType PName
pt { primTFixity :: Maybe Fixity
primTFixity = Maybe Fixity
f }
annotParameterType :: Annotates (ParameterType PName)
annotParameterType :: Annotates (ParameterType PName)
annotParameterType pt :: ParameterType PName
pt =
do Maybe Fixity
f <- PName -> StateT AnnotMap NoPatM (Maybe Fixity)
annotTyThing (Located PName -> PName
forall a. Located a -> a
thing (ParameterType PName -> Located PName
forall name. ParameterType name -> Located name
ptName ParameterType PName
pt))
Annotates (ParameterType PName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParameterType PName
pt { ptFixity :: Maybe Fixity
ptFixity = Maybe Fixity
f }
checkSigs :: PName -> [Located (Schema PName)] -> NoPatM (Maybe (Schema PName))
checkSigs :: PName -> [Located (Schema PName)] -> NoPatM (Maybe (Schema PName))
checkSigs _ [] = Maybe (Schema PName) -> NoPatM (Maybe (Schema PName))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Schema PName)
forall a. Maybe a
Nothing
checkSigs _ [s :: Located (Schema PName)
s] = Maybe (Schema PName) -> NoPatM (Maybe (Schema PName))
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema PName -> Maybe (Schema PName)
forall a. a -> Maybe a
Just (Located (Schema PName) -> Schema PName
forall a. Located a -> a
thing Located (Schema PName)
s))
checkSigs f :: PName
f xs :: [Located (Schema PName)]
xs@(s :: Located (Schema PName)
s : _ : _) = do Error -> NoPatM ()
recordError (Error -> NoPatM ()) -> Error -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ PName -> [Located (Schema PName)] -> Error
MultipleSignatures PName
f [Located (Schema PName)]
xs
Maybe (Schema PName) -> NoPatM (Maybe (Schema PName))
forall (m :: * -> *) a. Monad m => a -> m a
return (Schema PName -> Maybe (Schema PName)
forall a. a -> Maybe a
Just (Located (Schema PName) -> Schema PName
forall a. Located a -> a
thing Located (Schema PName)
s))
checkFixs :: PName -> [Located Fixity] -> NoPatM (Maybe Fixity)
checkFixs :: PName -> [Located Fixity] -> NoPatM (Maybe Fixity)
checkFixs _ [] = Maybe Fixity -> NoPatM (Maybe Fixity)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Fixity
forall a. Maybe a
Nothing
checkFixs _ [f :: Located Fixity
f] = Maybe Fixity -> NoPatM (Maybe Fixity)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just (Located Fixity -> Fixity
forall a. Located a -> a
thing Located Fixity
f))
checkFixs f :: PName
f fs :: [Located Fixity]
fs@(x :: Located Fixity
x:_) = do Error -> NoPatM ()
recordError (Error -> NoPatM ()) -> Error -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ PName -> [Range] -> Error
MultipleFixities PName
f ([Range] -> Error) -> [Range] -> Error
forall a b. (a -> b) -> a -> b
$ (Located Fixity -> Range) -> [Located Fixity] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map Located Fixity -> Range
forall a. Located a -> Range
srcRange [Located Fixity]
fs
Maybe Fixity -> NoPatM (Maybe Fixity)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fixity -> Maybe Fixity
forall a. a -> Maybe a
Just (Located Fixity -> Fixity
forall a. Located a -> a
thing Located Fixity
x))
checkDocs :: PName -> [Located String] -> NoPatM (Maybe String)
checkDocs :: PName -> [Located String] -> NoPatM (Maybe String)
checkDocs _ [] = Maybe String -> NoPatM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
checkDocs _ [d :: Located String
d] = Maybe String -> NoPatM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just (Located String -> String
forall a. Located a -> a
thing Located String
d))
checkDocs f :: PName
f ds :: [Located String]
ds@(d :: Located String
d:_) = do Error -> NoPatM ()
recordError (Error -> NoPatM ()) -> Error -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ PName -> [Range] -> Error
MultipleDocs PName
f ((Located String -> Range) -> [Located String] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map Located String -> Range
forall a. Located a -> Range
srcRange [Located String]
ds)
Maybe String -> NoPatM (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just (Located String -> String
forall a. Located a -> a
thing Located String
d))
toSig :: Decl PName -> [(PName, [Located (Schema PName)])]
toSig :: Decl PName -> [(PName, [Located (Schema PName)])]
toSig (DLocated d :: Decl PName
d _) = Decl PName -> [(PName, [Located (Schema PName)])]
toSig Decl PName
d
toSig (DSignature xs :: [Located PName]
xs s :: Schema PName
s) = [ (Located PName -> PName
forall a. Located a -> a
thing Located PName
x,[Range -> Schema PName -> Located (Schema PName)
forall a. Range -> a -> Located a
Located (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
x) Schema PName
s]) | Located PName
x <- [Located PName]
xs ]
toSig _ = []
toPragma :: Decl PName -> [(PName, [Located Pragma])]
toPragma :: Decl PName -> [(PName, [Located Pragma])]
toPragma (DLocated d :: Decl PName
d _) = Decl PName -> [(PName, [Located Pragma])]
toPragma Decl PName
d
toPragma (DPragma xs :: [Located PName]
xs s :: Pragma
s) = [ (Located PName -> PName
forall a. Located a -> a
thing Located PName
x,[Range -> Pragma -> Located Pragma
forall a. Range -> a -> Located a
Located (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
x) Pragma
s]) | Located PName
x <- [Located PName]
xs ]
toPragma _ = []
toFixity :: Decl PName -> [(PName, [Located Fixity])]
toFixity :: Decl PName -> [(PName, [Located Fixity])]
toFixity (DFixity f :: Fixity
f ns :: [Located PName]
ns) = [ (Located PName -> PName
forall a. Located a -> a
thing Located PName
n, [Range -> Fixity -> Located Fixity
forall a. Range -> a -> Located a
Located (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
n) Fixity
f]) | Located PName
n <- [Located PName]
ns ]
toFixity _ = []
toDocs :: TopLevel (Decl PName) -> [(PName, [Located String])]
toDocs :: TopLevel (Decl PName) -> [(PName, [Located String])]
toDocs TopLevel { .. }
| Just txt :: Located String
txt <- Maybe (Located String)
tlDoc = Located String -> Decl PName -> [(PName, [Located String])]
forall t a. t -> Decl a -> [(a, [t])]
go Located String
txt Decl PName
tlValue
| Bool
otherwise = []
where
go :: t -> Decl a -> [(a, [t])]
go txt :: t
txt decl :: Decl a
decl =
case Decl a
decl of
DSignature ns :: [Located a]
ns _ -> [ (Located a -> a
forall a. Located a -> a
thing Located a
n, [t
txt]) | Located a
n <- [Located a]
ns ]
DFixity _ ns :: [Located a]
ns -> [ (Located a -> a
forall a. Located a -> a
thing Located a
n, [t
txt]) | Located a
n <- [Located a]
ns ]
DBind b :: Bind a
b -> [ (Located a -> a
forall a. Located a -> a
thing (Bind a -> Located a
forall name. Bind name -> Located name
bName Bind a
b), [t
txt]) ]
DLocated d :: Decl a
d _ -> t -> Decl a -> [(a, [t])]
go t
txt Decl a
d
DPatBind p :: Pattern a
p _ -> [ (Located a -> a
forall a. Located a -> a
thing Located a
n, [t
txt]) | Located a
n <- Pattern a -> [Located a]
forall name. Pattern name -> [Located name]
namesP Pattern a
p ]
DPragma _ _ -> []
DType _ -> []
DProp _ -> []
newtype NoPatM a = M { NoPatM a -> ReaderT Range (StateT RW Id) a
unM :: ReaderT Range (StateT RW Id) a }
data RW = RW { RW -> Int
names :: !Int, RW -> [Error]
errors :: [Error] }
data Error = MultipleSignatures PName [Located (Schema PName)]
| SignatureNoBind (Located PName) (Schema PName)
| PragmaNoBind (Located PName) Pragma
| MultipleFixities PName [Range]
| FixityNoBind (Located PName)
| MultipleDocs PName [Range]
deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show,(forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Error x -> Error
$cfrom :: forall x. Error -> Rep Error x
Generic, Error -> ()
(Error -> ()) -> NFData Error
forall a. (a -> ()) -> NFData a
rnf :: Error -> ()
$crnf :: Error -> ()
NFData)
instance Functor NoPatM where fmap :: (a -> b) -> NoPatM a -> NoPatM b
fmap = (a -> b) -> NoPatM a -> NoPatM b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative NoPatM where pure :: a -> NoPatM a
pure = a -> NoPatM a
forall (m :: * -> *) a. Monad m => a -> m a
return; <*> :: NoPatM (a -> b) -> NoPatM a -> NoPatM b
(<*>) = NoPatM (a -> b) -> NoPatM a -> NoPatM b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad NoPatM where
return :: a -> NoPatM a
return x :: a
x = ReaderT Range (StateT RW Id) a -> NoPatM a
forall a. ReaderT Range (StateT RW Id) a -> NoPatM a
M (a -> ReaderT Range (StateT RW Id) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x)
M x :: ReaderT Range (StateT RW Id) a
x >>= :: NoPatM a -> (a -> NoPatM b) -> NoPatM b
>>= k :: a -> NoPatM b
k = ReaderT Range (StateT RW Id) b -> NoPatM b
forall a. ReaderT Range (StateT RW Id) a -> NoPatM a
M (ReaderT Range (StateT RW Id) a
x ReaderT Range (StateT RW Id) a
-> (a -> ReaderT Range (StateT RW Id) b)
-> ReaderT Range (StateT RW Id) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NoPatM b -> ReaderT Range (StateT RW Id) b
forall a. NoPatM a -> ReaderT Range (StateT RW Id) a
unM (NoPatM b -> ReaderT Range (StateT RW Id) b)
-> (a -> NoPatM b) -> a -> ReaderT Range (StateT RW Id) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NoPatM b
k)
newName :: NoPatM PName
newName :: NoPatM PName
newName = ReaderT Range (StateT RW Id) PName -> NoPatM PName
forall a. ReaderT Range (StateT RW Id) a -> NoPatM a
M (ReaderT Range (StateT RW Id) PName -> NoPatM PName)
-> ReaderT Range (StateT RW Id) PName -> NoPatM PName
forall a b. (a -> b) -> a -> b
$ (RW -> (PName, RW)) -> ReaderT Range (StateT RW Id) PName
forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
sets ((RW -> (PName, RW)) -> ReaderT Range (StateT RW Id) PName)
-> (RW -> (PName, RW)) -> ReaderT Range (StateT RW Id) PName
forall a b. (a -> b) -> a -> b
$ \s :: RW
s -> let x :: Int
x = RW -> Int
names RW
s
in (Pass -> Int -> PName
NewName Pass
NoPat Int
x, RW
s { names :: Int
names = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 })
recordError :: Error -> NoPatM ()
recordError :: Error -> NoPatM ()
recordError e :: Error
e = ReaderT Range (StateT RW Id) () -> NoPatM ()
forall a. ReaderT Range (StateT RW Id) a -> NoPatM a
M (ReaderT Range (StateT RW Id) () -> NoPatM ())
-> ReaderT Range (StateT RW Id) () -> NoPatM ()
forall a b. (a -> b) -> a -> b
$ (RW -> RW) -> ReaderT Range (StateT RW Id) ()
forall (m :: * -> *) s. StateM m s => (s -> s) -> m ()
sets_ ((RW -> RW) -> ReaderT Range (StateT RW Id) ())
-> (RW -> RW) -> ReaderT Range (StateT RW Id) ()
forall a b. (a -> b) -> a -> b
$ \s :: RW
s -> RW
s { errors :: [Error]
errors = Error
e Error -> [Error] -> [Error]
forall a. a -> [a] -> [a]
: RW -> [Error]
errors RW
s }
getRange :: NoPatM Range
getRange :: NoPatM Range
getRange = ReaderT Range (StateT RW Id) Range -> NoPatM Range
forall a. ReaderT Range (StateT RW Id) a -> NoPatM a
M ReaderT Range (StateT RW Id) Range
forall (m :: * -> *) i. ReaderM m i => m i
ask
inRange :: Range -> NoPatM a -> NoPatM a
inRange :: Range -> NoPatM a -> NoPatM a
inRange r :: Range
r m :: NoPatM a
m = ReaderT Range (StateT RW Id) a -> NoPatM a
forall a. ReaderT Range (StateT RW Id) a -> NoPatM a
M (ReaderT Range (StateT RW Id) a -> NoPatM a)
-> ReaderT Range (StateT RW Id) a -> NoPatM a
forall a b. (a -> b) -> a -> b
$ Range
-> ReaderT Range (StateT RW Id) a -> ReaderT Range (StateT RW Id) a
forall (m :: * -> *) i a. RunReaderM m i => i -> m a -> m a
local Range
r (ReaderT Range (StateT RW Id) a -> ReaderT Range (StateT RW Id) a)
-> ReaderT Range (StateT RW Id) a -> ReaderT Range (StateT RW Id) a
forall a b. (a -> b) -> a -> b
$ NoPatM a -> ReaderT Range (StateT RW Id) a
forall a. NoPatM a -> ReaderT Range (StateT RW Id) a
unM NoPatM a
m
runNoPatM :: NoPatM a -> (a, [Error])
runNoPatM :: NoPatM a -> (a, [Error])
runNoPatM m :: NoPatM a
m
= (a, RW) -> (a, [Error])
forall a. (a, RW) -> (a, [Error])
getErrs
((a, RW) -> (a, [Error])) -> (a, RW) -> (a, [Error])
forall a b. (a -> b) -> a -> b
$ Id (a, RW) -> (a, RW)
forall a. Id a -> a
runId
(Id (a, RW) -> (a, RW)) -> Id (a, RW) -> (a, RW)
forall a b. (a -> b) -> a -> b
$ RW -> StateT RW Id a -> Id (a, RW)
forall i (m :: * -> *) a. i -> StateT i m a -> m (a, i)
runStateT $WRW :: Int -> [Error] -> RW
RW { names :: Int
names = 0, errors :: [Error]
errors = [] }
(StateT RW Id a -> Id (a, RW)) -> StateT RW Id a -> Id (a, RW)
forall a b. (a -> b) -> a -> b
$ Range -> ReaderT Range (StateT RW Id) a -> StateT RW Id a
forall i (m :: * -> *) a. i -> ReaderT i m a -> m a
runReaderT (Position -> Position -> String -> Range
Range Position
start Position
start "")
(ReaderT Range (StateT RW Id) a -> StateT RW Id a)
-> ReaderT Range (StateT RW Id) a -> StateT RW Id a
forall a b. (a -> b) -> a -> b
$ NoPatM a -> ReaderT Range (StateT RW Id) a
forall a. NoPatM a -> ReaderT Range (StateT RW Id) a
unM NoPatM a
m
where getErrs :: (a, RW) -> (a, [Error])
getErrs (a :: a
a,rw :: RW
rw) = (a
a, RW -> [Error]
errors RW
rw)
instance PP Error where
ppPrec :: Int -> Error -> Doc
ppPrec _ err :: Error
err =
case Error
err of
MultipleSignatures x :: PName
x ss :: [Located (Schema PName)]
ss ->
String -> Doc
text "Multiple type signatures for" Doc -> Doc -> Doc
<+> Doc -> Doc
quotes (PName -> Doc
forall a. PP a => a -> Doc
pp PName
x)
Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest 2 ([Doc] -> Doc
vcat ((Located (Schema PName) -> Doc)
-> [Located (Schema PName)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Located (Schema PName) -> Doc
forall a. PP a => a -> Doc
pp [Located (Schema PName)]
ss))
SignatureNoBind x :: Located PName
x s :: Schema PName
s ->
String -> Doc
text "At" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
x) Doc -> Doc -> Doc
<.> Doc
colon Doc -> Doc -> Doc
<+>
String -> Doc
text "Type signature without a matching binding:"
Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest 2 (PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
x) Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> Schema PName -> Doc
forall a. PP a => a -> Doc
pp Schema PName
s)
PragmaNoBind x :: Located PName
x s :: Pragma
s ->
String -> Doc
text "At" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
x) Doc -> Doc -> Doc
<.> Doc
colon Doc -> Doc -> Doc
<+>
String -> Doc
text "Pragma without a matching binding:"
Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest 2 (Pragma -> Doc
forall a. PP a => a -> Doc
pp Pragma
s)
MultipleFixities n :: PName
n locs :: [Range]
locs ->
String -> Doc
text "Multiple fixity declarations for" Doc -> Doc -> Doc
<+> Doc -> Doc
quotes (PName -> Doc
forall a. PP a => a -> Doc
pp PName
n)
Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest 2 ([Doc] -> Doc
vcat ((Range -> Doc) -> [Range] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Doc
forall a. PP a => a -> Doc
pp [Range]
locs))
FixityNoBind n :: Located PName
n ->
String -> Doc
text "At" Doc -> Doc -> Doc
<+> Range -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> Range
forall a. Located a -> Range
srcRange Located PName
n) Doc -> Doc -> Doc
<.> Doc
colon Doc -> Doc -> Doc
<+>
String -> Doc
text "Fixity declaration without a matching binding for:" Doc -> Doc -> Doc
<+>
PName -> Doc
forall a. PP a => a -> Doc
pp (Located PName -> PName
forall a. Located a -> a
thing Located PName
n)
MultipleDocs n :: PName
n locs :: [Range]
locs ->
String -> Doc
text "Multiple documentation blocks given for:" Doc -> Doc -> Doc
<+> PName -> Doc
forall a. PP a => a -> Doc
pp PName
n
Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest 2 ([Doc] -> Doc
vcat ((Range -> Doc) -> [Range] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Range -> Doc
forall a. PP a => a -> Doc
pp [Range]
locs))