    -- |
    -- Module      :  Cryptol.Parser.ParserUtils
    -- Copyright   :  (c) 2013-2016 Galois, Inc.
    -- License     :  BSD3
    -- Maintainer  :  cryptol@galois.com
    -- Stability   :  provisional
    -- Portability :  portable

    {-# LANGUAGE Safe #-}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE BlockArguments #-}
    {-# LANGUAGE OverloadedStrings #-}
    -- See Note [-Wincomplete-uni-patterns and irrefutable patterns] in Cryptol.TypeCheck.TypePat
    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    module Cryptol.Parser.ParserUtils where

    import qualified Data.Text as Text
    import Data.Char(isAlphaNum)
    import Data.Maybe(fromMaybe)
    import Data.Bits(testBit,setBit)
    import Data.Maybe(mapMaybe)
    import Data.List(foldl')
    import Data.List.NonEmpty ( NonEmpty(..) )
    import qualified Data.List.NonEmpty as NE
    import Control.Monad(liftM,ap,unless,guard,msum)
    import qualified Control.Monad.Fail as Fail
    import           Data.Text(Text)
    import qualified Data.Text as T
    import qualified Data.Map as Map
    import Text.Read(readMaybe)

    import GHC.Generics (Generic)
    import Control.DeepSeq

    import Prelude ()
    import Prelude.Compat

    import Cryptol.Parser.AST
    import Cryptol.Parser.Lexer
    import Cryptol.Parser.Token(SelectorType(..))
    import Cryptol.Parser.Position
    import Cryptol.Parser.Utils (translateExprToNumT,widthIdent)
    import Cryptol.Utils.Ident( packModName,packIdent,modNameChunks
                              , identAnonArg, identAnonIfaceMod
                              , modNameArg, modNameIfaceMod
                              , modNameToText, modNameIsNormal
                              , modNameToNormalModName
                              , unpackIdent
                              )
    import Cryptol.Utils.PP
    import Cryptol.Utils.Panic
    import Cryptol.Utils.RecordMap

    parseString :: Config -> ParseM a -> String -> Either ParseError a
    parseString :: forall a. Config -> ParseM a -> [Char] -> Either ParseError a
    parseString Config
    cfg ParseM a
    p [Char]
    cs = Config -> ParseM a -> Text -> Either ParseError a
    forall a. Config -> ParseM a -> Text -> Either ParseError a
    parse Config
    cfg ParseM a
    p ([Char] -> Text
    T.pack [Char]
    cs)

    parse :: Config -> ParseM a -> Text -> Either ParseError a
    parse :: forall a. Config -> ParseM a -> Text -> Either ParseError a
    parse Config
    cfg ParseM a
    p Text
    cs    = case ParseM a -> Config -> Position -> S -> Either ParseError (a, S)
    forall a.
    ParseM a -> Config -> Position -> S -> Either ParseError (a, S)
    unP ParseM a
    p Config
    cfg Position
    eofPos S { sPrevTok :: Maybe (Located Token)
    sPrevTok = Maybe (Located Token)
    forall a. Maybe a
    Nothing
                                                , sTokens :: [Located Token]
    sTokens = [Located Token]
    toks
                                                , sNextTyParamNum :: Int
    sNextTyParamNum = Int
    0
                                                } of
                          Left ParseError
    err    -> ParseError -> Either ParseError a
    forall a b. a -> Either a b
    Left ParseError
    err
                          Right (a
    a,S
    _) -> a -> Either ParseError a
    forall a b. b -> Either a b
    Right a
    a
      where ([Located Token]
    toks,Position
    eofPos) = Config -> Text -> ([Located Token], Position)
    lexer Config
    cfg Text
    cs

    {- The parser is parameterized by the pozition of the final token. -}
    newtype ParseM a =
      P { forall a.
    ParseM a -> Config -> Position -> S -> Either ParseError (a, S)
    unP :: Config -> Position -> S -> Either ParseError (a,S) }

    lexerP :: (Located Token -> ParseM a) -> ParseM a
    lexerP :: forall a. (Located Token -> ParseM a) -> ParseM a
    lexerP Located Token -> ParseM a
    k = (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    forall a.
    (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    P ((Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a)
    -> (Config -> Position -> S -> Either ParseError (a, S))
    -> ParseM a
    forall a b. (a -> b) -> a -> b
    $ \Config
    cfg Position
    p S
    s ->
      case S -> [Located Token]
    sTokens S
    s of
        Located Token
    t : [Located Token]
    _ | Err TokenErr
    e <- Token -> TokenT
    tokenType Token
    it ->
          ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left (ParseError -> Either ParseError (a, S))
    -> ParseError -> Either ParseError (a, S)
    forall a b. (a -> b) -> a -> b
    $ Range -> [[Char]] -> ParseError
    HappyErrorMsg (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    t) ([[Char]] -> ParseError) -> [[Char]] -> ParseError
    forall a b. (a -> b) -> a -> b
    $
            [case TokenErr
    e of
               TokenErr
    UnterminatedComment -> [Char]
    "unterminated comment"
               TokenErr
    UnterminatedString  -> [Char]
    "unterminated string"
               TokenErr
    UnterminatedChar    -> [Char]
    "unterminated character"
               TokenErr
    InvalidString       -> [Char]
    "invalid string literal: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                        Text -> [Char]
    T.unpack (Token -> Text
    tokenText Token
    it)
               TokenErr
    InvalidChar         -> [Char]
    "invalid character literal: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                        Text -> [Char]
    T.unpack (Token -> Text
    tokenText Token
    it)
               TokenErr
    LexicalError        -> [Char]
    "unrecognized character: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                        Text -> [Char]
    T.unpack (Token -> Text
    tokenText Token
    it)
               TokenErr
    MalformedLiteral    -> [Char]
    "malformed literal: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                        Text -> [Char]
    T.unpack (Token -> Text
    tokenText Token
    it)
               TokenErr
    MalformedSelector   -> [Char]
    "malformed selector: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                        Text -> [Char]
    T.unpack (Token -> Text
    tokenText Token
    it)
               InvalidIndentation TokenT
    c -> [Char]
    "invalid indentation, unmatched " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                  case TokenT
    c of
                    Sym TokenSym
    CurlyR    -> [Char]
    "{ ... } "
                    Sym TokenSym
    ParenR    -> [Char]
    "( ... )"
                    Sym TokenSym
    BracketR  -> [Char]
    "[ ... ]"
                    TokenT
    _             -> TokenT -> [Char]
    forall a. Show a => a -> [Char]
    show TokenT
    c -- basically panic
            ]
          where it :: Token
    it = Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    t

        Located Token
    t : [Located Token]
    more -> ParseM a -> Config -> Position -> S -> Either ParseError (a, S)
    forall a.
    ParseM a -> Config -> Position -> S -> Either ParseError (a, S)
    unP (Located Token -> ParseM a
    k Located Token
    t) Config
    cfg Position
    p S
    s { sPrevTok :: Maybe (Located Token)
    sPrevTok = Located Token -> Maybe (Located Token)
    forall a. a -> Maybe a
    Just Located Token
    t, sTokens :: [Located Token]
    sTokens = [Located Token]
    more }
        [] -> ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left ([Char] -> Position -> ParseError
    HappyOutOfTokens (Config -> [Char]
    cfgSource Config
    cfg) Position
    p)

    data ParseError = HappyError FilePath         {- Name of source file -}
                                 (Located Token)  {- Offending token -}
                    | HappyErrorMsg Range [String]
                    | HappyUnexpected FilePath (Maybe (Located Token)) String
                    | HappyOutOfTokens FilePath Position
                      deriving (Int -> ParseError -> [Char] -> [Char]
    [ParseError] -> [Char] -> [Char]
    ParseError -> [Char]
    (Int -> ParseError -> [Char] -> [Char])
    -> (ParseError -> [Char])
    -> ([ParseError] -> [Char] -> [Char])
    -> Show ParseError
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> ParseError -> [Char] -> [Char]
    showsPrec :: Int -> ParseError -> [Char] -> [Char]
    $cshow :: ParseError -> [Char]
    show :: ParseError -> [Char]
    $cshowList :: [ParseError] -> [Char] -> [Char]
    showList :: [ParseError] -> [Char] -> [Char]
    Show, (forall x. ParseError -> Rep ParseError x)
    -> (forall x. Rep ParseError x -> ParseError) -> Generic ParseError
    forall x. Rep ParseError x -> ParseError
    forall x. ParseError -> Rep ParseError x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ParseError -> Rep ParseError x
    from :: forall x. ParseError -> Rep ParseError x
    $cto :: forall x. Rep ParseError x -> ParseError
    to :: forall x. Rep ParseError x -> ParseError
    Generic, ParseError -> ()
    (ParseError -> ()) -> NFData ParseError
    forall a. (a -> ()) -> NFData a
    $crnf :: ParseError -> ()
    rnf :: ParseError -> ()
    NFData)

    data S = S { S -> Maybe (Located Token)
    sPrevTok :: Maybe (Located Token)
               , S -> [Located Token]
    sTokens :: [Located Token]
               , S -> Int
    sNextTyParamNum :: !Int
                 -- ^ Keep track of the type parameters as they appear in the input
               }

    ppError :: ParseError -> Doc

    ppError :: ParseError -> Doc
    ppError (HappyError [Char]
    path Located Token
    ltok)
      | Err TokenErr
    _ <- Token -> TokenT
    tokenType Token
    tok =
        [Char] -> Doc
    text [Char]
    "Parse error at" Doc -> Doc -> Doc
    <+>
        [Char] -> Doc
    text [Char]
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    char Char
    ':' Doc -> Doc -> Doc
    <.> Position -> Doc
    forall a. PP a => a -> Doc
    pp Position
    pos Doc -> Doc -> Doc
    <.> Doc
    comma Doc -> Doc -> Doc
    <+>
        Token -> Doc
    forall a. PP a => a -> Doc
    pp Token
    tok

      | White TokenW
    DocStr <- Token -> TokenT
    tokenType Token
    tok =
        Doc
    "Unexpected documentation (/**) comment at" Doc -> Doc -> Doc
    <+>
        [Char] -> Doc
    text [Char]
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    char Char
    ':' Doc -> Doc -> Doc
    <.> Position -> Doc
    forall a. PP a => a -> Doc
    pp Position
    pos Doc -> Doc -> Doc
    <.> Doc
    colon Doc -> Doc -> Doc
    $$
        Int -> Doc -> Doc
    indent Int
    2
          Doc
    "Documentation comments need to be followed by something to document."

      | Bool
    otherwise =
        [Char] -> Doc
    text [Char]
    "Parse error at" Doc -> Doc -> Doc
    <+>
        [Char] -> Doc
    text [Char]
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    char Char
    ':' Doc -> Doc -> Doc
    <.> Position -> Doc
    forall a. PP a => a -> Doc
    pp Position
    pos Doc -> Doc -> Doc
    <.> Doc
    comma Doc -> Doc -> Doc
    $$
        Int -> Doc -> Doc
    indent Int
    2 ([Char] -> Doc
    text [Char]
    "unexpected:" Doc -> Doc -> Doc
    <+> Token -> Doc
    forall a. PP a => a -> Doc
    pp Token
    tok)
      where
      pos :: Position
    pos = Range -> Position
    from (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    ltok)
      tok :: Token
    tok = Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    ltok

    ppError (HappyOutOfTokens [Char]
    path Position
    pos) =
      [Char] -> Doc
    text [Char]
    "Unexpected end of file at:" Doc -> Doc -> Doc
    <+>
        [Char] -> Doc
    text [Char]
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    char Char
    ':' Doc -> Doc -> Doc
    <.> Position -> Doc
    forall a. PP a => a -> Doc
    pp Position
    pos

    ppError (HappyErrorMsg Range
    p [[Char]]
    xs)  = [Char] -> Doc
    text [Char]
    "Parse error at" Doc -> Doc -> Doc
    <+> Range -> Doc
    forall a. PP a => a -> Doc
    pp Range
    p Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    indent Int
    2 ([Doc] -> Doc
    vcat (([Char] -> Doc) -> [[Char]] -> [Doc]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> Doc
    text [[Char]]
    xs))

    ppError (HappyUnexpected [Char]
    path Maybe (Located Token)
    ltok [Char]
    e) =
      Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $
       [ [Char] -> Doc
    text [Char]
    "Parse error at" Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text [Char]
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    char Char
    ':' Doc -> Doc -> Doc
    <.> Position -> Doc
    forall a. PP a => a -> Doc
    pp Position
    pos Doc -> Doc -> Doc
    <.> Doc
    comma ]
       [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [Doc]
    unexp
       [Doc] -> [Doc] -> [Doc]
    forall a. [a] -> [a] -> [a]
    ++ [Doc
    "expected:" Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text [Char]
    e]
      where
      ([Doc]
    unexp,Position
    pos) =
        case Maybe (Located Token)
    ltok of
          Maybe (Located Token)
    Nothing -> ( [] ,Position
    start)
          Just Located Token
    t  -> ( [Doc
    "unexpected:" Doc -> Doc -> Doc
    <+> [Char] -> Doc
    text (Text -> [Char]
    T.unpack (Token -> Text
    tokenText (Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    t)))]
                     , Range -> Position
    from (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    t)
                     )

    instance Functor ParseM where
      fmap :: forall a b. (a -> b) -> ParseM a -> ParseM b
    fmap = (a -> b) -> ParseM a -> ParseM b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative ParseM where
      pure :: forall a. a -> ParseM a
    pure a
    a = (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    forall a.
    (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    P (\Config
    _ Position
    _ S
    s -> (a, S) -> Either ParseError (a, S)
    forall a b. b -> Either a b
    Right (a
    a,S
    s))
      <*> :: forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    (<*>) = ParseM (a -> b) -> ParseM a -> ParseM b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad ParseM where
      return :: forall a. a -> ParseM a
    return    = a -> ParseM a
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
      ParseM a
    m >>= :: forall a b. ParseM a -> (a -> ParseM b) -> ParseM b
    >>= a -> ParseM b
    k   = (Config -> Position -> S -> Either ParseError (b, S)) -> ParseM b
    forall a.
    (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    P (\Config
    cfg Position
    p S
    s1 -> case ParseM a -> Config -> Position -> S -> Either ParseError (a, S)
    forall a.
    ParseM a -> Config -> Position -> S -> Either ParseError (a, S)
    unP ParseM a
    m Config
    cfg Position
    p S
    s1 of
                                Left ParseError
    e       -> ParseError -> Either ParseError (b, S)
    forall a b. a -> Either a b
    Left ParseError
    e
                                Right (a
    a,S
    s2) -> ParseM b -> Config -> Position -> S -> Either ParseError (b, S)
    forall a.
    ParseM a -> Config -> Position -> S -> Either ParseError (a, S)
    unP (a -> ParseM b
    k a
    a) Config
    cfg Position
    p S
    s2)

    instance Fail.MonadFail ParseM where
      fail :: forall a. [Char] -> ParseM a
    fail [Char]
    s    = [Char] -> [[Char]] -> ParseM a
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "[Parser] fail" [[Char]
    s]

    happyError :: ParseM a
    happyError :: forall a. ParseM a
    happyError = (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    forall a.
    (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    P ((Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a)
    -> (Config -> Position -> S -> Either ParseError (a, S))
    -> ParseM a
    forall a b. (a -> b) -> a -> b
    $ \Config
    cfg Position
    _ S
    s ->
      case S -> Maybe (Located Token)
    sPrevTok S
    s of
        Just Located Token
    t  -> ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left ([Char] -> Located Token -> ParseError
    HappyError (Config -> [Char]
    cfgSource Config
    cfg) Located Token
    t)
        Maybe (Located Token)
    Nothing ->
          ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left (Range -> [[Char]] -> ParseError
    HappyErrorMsg Range
    emptyRange [[Char]
    "Parse error at the beginning of the file"])

    errorMessage :: Range -> [String] -> ParseM a
    errorMessage :: forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    r [[Char]]
    xs = (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    forall a.
    (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    P ((Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a)
    -> (Config -> Position -> S -> Either ParseError (a, S))
    -> ParseM a
    forall a b. (a -> b) -> a -> b
    $ \Config
    _ Position
    _ S
    _ -> ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left (Range -> [[Char]] -> ParseError
    HappyErrorMsg Range
    r [[Char]]
    xs)

    customError :: String -> Located Token -> ParseM a
    customError :: forall a. [Char] -> Located Token -> ParseM a
    customError [Char]
    x Located Token
    t = (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    forall a.
    (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    P ((Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a)
    -> (Config -> Position -> S -> Either ParseError (a, S))
    -> ParseM a
    forall a b. (a -> b) -> a -> b
    $ \Config
    _ Position
    _ S
    _ -> ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left (Range -> [[Char]] -> ParseError
    HappyErrorMsg (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    t) [[Char]
    x])

    expected :: String -> ParseM a
    expected :: forall a. [Char] -> ParseM a
    expected [Char]
    x = (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    forall a.
    (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    P ((Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a)
    -> (Config -> Position -> S -> Either ParseError (a, S))
    -> ParseM a
    forall a b. (a -> b) -> a -> b
    $ \Config
    cfg Position
    _ S
    s ->
                        ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left ([Char] -> Maybe (Located Token) -> [Char] -> ParseError
    HappyUnexpected (Config -> [Char]
    cfgSource Config
    cfg) (S -> Maybe (Located Token)
    sPrevTok S
    s) [Char]
    x)

    mkModName :: [Text] -> ModName
    mkModName :: [Text] -> ModName
    mkModName = [Text] -> ModName
    packModName

    -- | This is how we derive the name of a module parameter from the
    -- @import source@ declaration.
    mkModParamName :: Located (ImpName PName) -> Maybe (Located ModName) -> Ident
    mkModParamName :: Located (ImpName PName) -> Maybe (Located ModName) -> Ident
    mkModParamName Located (ImpName PName)
    lsig Maybe (Located ModName)
    qual =
      case Maybe (Located ModName)
    qual of
        Maybe (Located ModName)
    Nothing ->
          case Located (ImpName PName) -> ImpName PName
    forall a. Located a -> a
    thing Located (ImpName PName)
    lsig of
            ImpTop ModName
    t
              | ModName -> Bool
    modNameIsNormal ModName
    t -> [Char] -> Ident
    packIdent ([[Char]] -> [Char]
    forall a. HasCallStack => [a] -> a
    last (ModName -> [[Char]]
    modNameChunks ModName
    t))
              | Bool
    otherwise         -> Ident -> Ident
    identAnonIfaceMod
                                   (Ident -> Ident) -> Ident -> Ident
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Ident
    packIdent
                                   ([Char] -> Ident) -> [Char] -> Ident
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall a. HasCallStack => [a] -> a
    last
                                   ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ModName -> [[Char]]
    modNameChunks
                                   (ModName -> [[Char]]) -> ModName -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ ModName -> ModName
    modNameToNormalModName ModName
    t
            ImpNested PName
    nm ->
              case PName
    nm of
                UnQual Ident
    i -> Ident
    i
                Qual ModName
    _ Ident
    i -> Ident
    i
                NewName {} -> [Char] -> [[Char]] -> Ident
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "mkModParamName" [[Char]
    "Unexpected NewName",Located (ImpName PName) -> [Char]
    forall a. Show a => a -> [Char]
    show Located (ImpName PName)
    lsig]
        Just Located ModName
    m -> [Char] -> Ident
    packIdent ([[Char]] -> [Char]
    forall a. HasCallStack => [a] -> a
    last (ModName -> [[Char]]
    modNameChunks (Located ModName -> ModName
    forall a. Located a -> a
    thing Located ModName
    m)))

    -- Note that type variables are not resolved at this point: they are tcons.
    mkSchema :: [TParam PName] -> [Prop PName] -> Type PName -> Schema PName
    mkSchema :: [TParam PName] -> [Prop PName] -> Type PName -> Schema PName
    mkSchema [TParam PName]
    xs [Prop PName]
    ps Type PName
    t = [TParam PName]
    -> [Prop PName] -> Type PName -> Maybe Range -> Schema PName
    forall n.
    [TParam n] -> [Prop n] -> Type n -> Maybe Range -> Schema n
    Forall [TParam PName]
    xs [Prop PName]
    ps Type PName
    t Maybe Range
    forall a. Maybe a
    Nothing

    getName :: Located Token -> PName
    getName :: Located Token -> PName
    getName Located Token
    l = case Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    l of
                  Token (Ident [] Text
    x) Text
    _ -> Ident -> PName
    mkUnqual (Text -> Ident
    mkIdent Text
    x)
                  Token
    _ -> [Char] -> [[Char]] -> PName
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "[Parser] getName" [[Char]
    "not an Ident:", Located Token -> [Char]
    forall a. Show a => a -> [Char]
    show Located Token
    l]

    getNum :: Located Token -> Integer
    getNum :: Located Token -> Integer
    getNum Located Token
    l = case Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    l of
                 Token (Num Integer
    x Int
    _ Int
    _) Text
    _ -> Integer
    x
                 Token (ChrLit Char
    x) Text
    _  -> Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Char -> Int
    forall a. Enum a => a -> Int
    fromEnum Char
    x)
                 Token
    _ -> [Char] -> [[Char]] -> Integer
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "[Parser] getNum" [[Char]
    "not a number:", Located Token -> [Char]
    forall a. Show a => a -> [Char]
    show Located Token
    l]

    getChr :: Located Token -> Char
    getChr :: Located Token -> Char
    getChr Located Token
    l = case Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    l of
                 Token (ChrLit Char
    x) Text
    _  -> Char
    x
                 Token
    _ -> [Char] -> [[Char]] -> Char
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "[Parser] getChr" [[Char]
    "not a char:", Located Token -> [Char]
    forall a. Show a => a -> [Char]
    show Located Token
    l]

    getStr :: Located Token -> String
    getStr :: Located Token -> [Char]
    getStr Located Token
    l = case Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    l of
                 Token (StrLit [Char]
    x) Text
    _ -> [Char]
    x
                 Token
    _ -> [Char] -> [[Char]] -> [Char]
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "[Parser] getStr" [[Char]
    "not a string:", Located Token -> [Char]
    forall a. Show a => a -> [Char]
    show Located Token
    l]

    numLit :: Token -> Expr PName
    numLit :: Token -> Expr PName
    numLit Token { tokenText :: Token -> Text
    tokenText = Text
    txt, tokenType :: Token -> TokenT
    tokenType = Num Integer
    x Int
    base Int
    digs }
      | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2   = Literal -> Expr PName
    forall n. Literal -> Expr n
    ELit (Literal -> Expr PName) -> Literal -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Integer -> NumInfo -> Literal
    ECNum Integer
    x (Text -> Int -> NumInfo
    BinLit Text
    txt Int
    digs)
      | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    8   = Literal -> Expr PName
    forall n. Literal -> Expr n
    ELit (Literal -> Expr PName) -> Literal -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Integer -> NumInfo -> Literal
    ECNum Integer
    x (Text -> Int -> NumInfo
    OctLit Text
    txt Int
    digs)
      | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    10  = Literal -> Expr PName
    forall n. Literal -> Expr n
    ELit (Literal -> Expr PName) -> Literal -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Integer -> NumInfo -> Literal
    ECNum Integer
    x (Text -> NumInfo
    DecLit Text
    txt)
      | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    16  = Literal -> Expr PName
    forall n. Literal -> Expr n
    ELit (Literal -> Expr PName) -> Literal -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Integer -> NumInfo -> Literal
    ECNum Integer
    x (Text -> Int -> NumInfo
    HexLit Text
    txt Int
    digs)

    numLit Token
    x = [Char] -> [[Char]] -> Expr PName
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "[Parser] numLit" [[Char]
    "invalid numeric literal", Token -> [Char]
    forall a. Show a => a -> [Char]
    show Token
    x]

    fracLit :: Token -> Expr PName
    fracLit :: Token -> Expr PName
    fracLit Token
    tok =
      case Token -> TokenT
    tokenType Token
    tok of
        Frac Rational
    x Int
    base
          | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    2   -> Literal -> Expr PName
    forall n. Literal -> Expr n
    ELit (Literal -> Expr PName) -> Literal -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Rational -> FracInfo -> Literal
    ECFrac Rational
    x (FracInfo -> Literal) -> FracInfo -> Literal
    forall a b. (a -> b) -> a -> b
    $ Text -> FracInfo
    BinFrac (Text -> FracInfo) -> Text -> FracInfo
    forall a b. (a -> b) -> a -> b
    $ Token -> Text
    tokenText Token
    tok
          | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    8   -> Literal -> Expr PName
    forall n. Literal -> Expr n
    ELit (Literal -> Expr PName) -> Literal -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Rational -> FracInfo -> Literal
    ECFrac Rational
    x (FracInfo -> Literal) -> FracInfo -> Literal
    forall a b. (a -> b) -> a -> b
    $ Text -> FracInfo
    OctFrac (Text -> FracInfo) -> Text -> FracInfo
    forall a b. (a -> b) -> a -> b
    $ Token -> Text
    tokenText Token
    tok
          | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    10  -> Literal -> Expr PName
    forall n. Literal -> Expr n
    ELit (Literal -> Expr PName) -> Literal -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Rational -> FracInfo -> Literal
    ECFrac Rational
    x (FracInfo -> Literal) -> FracInfo -> Literal
    forall a b. (a -> b) -> a -> b
    $ Text -> FracInfo
    DecFrac (Text -> FracInfo) -> Text -> FracInfo
    forall a b. (a -> b) -> a -> b
    $ Token -> Text
    tokenText Token
    tok
          | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    16  -> Literal -> Expr PName
    forall n. Literal -> Expr n
    ELit (Literal -> Expr PName) -> Literal -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Rational -> FracInfo -> Literal
    ECFrac Rational
    x (FracInfo -> Literal) -> FracInfo -> Literal
    forall a b. (a -> b) -> a -> b
    $ Text -> FracInfo
    HexFrac (Text -> FracInfo) -> Text -> FracInfo
    forall a b. (a -> b) -> a -> b
    $ Token -> Text
    tokenText Token
    tok
        TokenT
    _ -> [Char] -> [[Char]] -> Expr PName
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "[Parser] fracLit" [ [Char]
    "Invalid fraction", Token -> [Char]
    forall a. Show a => a -> [Char]
    show Token
    tok ]

    intVal :: Located Token -> ParseM Integer
    intVal :: Located Token -> ParseM Integer
    intVal Located Token
    tok =
      case Token -> TokenT
    tokenType (Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    tok) of
        Num Integer
    x Int
    _ Int
    _ -> Integer -> ParseM Integer
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    x
        TokenT
    _         -> Range -> [[Char]] -> ParseM Integer
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    tok) [[Char]
    "Expected an integer"]

    mkFixity :: Assoc -> Located Token -> [LPName] -> ParseM (Decl PName)
    mkFixity :: Assoc -> Located Token -> [LPName] -> ParseM (Decl PName)
    mkFixity Assoc
    assoc Located Token
    tok [LPName]
    qns =
      do Integer
    l <- Located Token -> ParseM Integer
    intVal Located Token
    tok
         Bool -> ParseM () -> ParseM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Integer
    l Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    1 Bool -> Bool -> Bool
    && Integer
    l Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    100)
              (Range -> [[Char]] -> ParseM ()
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    tok) [[Char]
    "Fixity levels must be between 1 and 100"])
         Decl PName -> ParseM (Decl PName)
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Fixity -> [LPName] -> Decl PName
    forall name. Fixity -> [Located name] -> Decl name
    DFixity (Assoc -> Int -> Fixity
    Fixity Assoc
    assoc (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    l)) [LPName]
    qns)

    fromStrLit :: Located Token -> ParseM (Located String)
    fromStrLit :: Located Token -> ParseM (Located [Char])
    fromStrLit Located Token
    loc = case Token -> TokenT
    tokenType (Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    loc) of
      StrLit [Char]
    str -> Located [Char] -> ParseM (Located [Char])
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Located Token
    loc { thing :: [Char]
    thing = [Char]
    str }
      TokenT
    _          -> Range -> [[Char]] -> ParseM (Located [Char])
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    loc) [[Char]
    "Expected a string literal"]

    validDemotedType :: Range -> Type PName -> ParseM (Type PName)
    validDemotedType :: Range -> Type PName -> ParseM (Type PName)
    validDemotedType Range
    rng Type PName
    ty =
      case Type PName
    ty of
        TLocated Type PName
    t Range
    r -> Range -> Type PName -> ParseM (Type PName)
    validDemotedType Range
    r Type PName
    t
        TRecord {}   -> [Char] -> ParseM (Type PName)
    forall a. [Char] -> ParseM a
    bad [Char]
    "Record types"
        TTyApp {}    -> [Char] -> ParseM (Type PName)
    forall a. [Char] -> ParseM a
    bad [Char]
    "Explicit type application"
        TTuple {}    -> [Char] -> ParseM (Type PName)
    forall a. [Char] -> ParseM a
    bad [Char]
    "Tuple types"
        TFun {}      -> [Char] -> ParseM (Type PName)
    forall a. [Char] -> ParseM a
    bad [Char]
    "Function types"
        TSeq {}      -> [Char] -> ParseM (Type PName)
    forall a. [Char] -> ParseM a
    bad [Char]
    "Sequence types"
        Type PName
    TBit         -> [Char] -> ParseM (Type PName)
    forall a. [Char] -> ParseM a
    bad [Char]
    "Type bit"
        TNum {}      -> ParseM (Type PName)
    ok
        TChar {}     -> ParseM (Type PName)
    ok
        Type PName
    TWild        -> [Char] -> ParseM (Type PName)
    forall a. [Char] -> ParseM a
    bad [Char]
    "Wildcard types"
        TUser {}     -> ParseM (Type PName)
    ok

        TParens Type PName
    t Maybe Kind
    mb -> case Maybe Kind
    mb of
                          Maybe Kind
    Nothing -> Range -> Type PName -> ParseM (Type PName)
    validDemotedType Range
    rng Type PName
    t
                          Just Kind
    _  -> [Char] -> ParseM (Type PName)
    forall a. [Char] -> ParseM a
    bad [Char]
    "kind annotation"
        TInfix{}     -> ParseM (Type PName)
    ok

      where bad :: [Char] -> ParseM a
    bad [Char]
    x = Range -> [[Char]] -> ParseM a
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    rng [[Char]
    x [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " cannot be demoted."]
            ok :: ParseM (Type PName)
    ok    = Type PName -> ParseM (Type PName)
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type PName -> ParseM (Type PName))
    -> Type PName -> ParseM (Type PName)
    forall a b. (a -> b) -> a -> b
    $ Range -> Type PName -> Type PName
    forall l t. (HasLoc l, AddLoc t) => l -> t -> t
    at Range
    rng Type PName
    ty

    -- | Input fields are reversed!
    mkRecord :: AddLoc b => Range -> (RecordMap Ident (Range, a) -> b) -> [Named a] -> ParseM b
    mkRecord :: forall b a.
    AddLoc b =>
    Range -> (RecordMap Ident (Range, a) -> b) -> [Named a] -> ParseM b
    mkRecord Range
    rng RecordMap Ident (Range, a) -> b
    f [Named a]
    xs =
       case Either (Ident, (Range, a)) (RecordMap Ident (Range, a))
    res of
         Left (Ident
    nm,(Range
    nmRng,a
    _)) -> Range -> [[Char]] -> ParseM b
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    nmRng [[Char]
    "Record has repeated field: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Doc -> [Char]
    forall a. Show a => a -> [Char]
    show (Ident -> Doc
    forall a. PP a => a -> Doc
    pp Ident
    nm)]
         Right RecordMap Ident (Range, a)
    r -> b -> ParseM b
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (b -> ParseM b) -> b -> ParseM b
    forall a b. (a -> b) -> a -> b
    $ Range -> b -> b
    forall l t. (HasLoc l, AddLoc t) => l -> t -> t
    at Range
    rng (RecordMap Ident (Range, a) -> b
    f RecordMap Ident (Range, a)
    r)

      where
      res :: Either (Ident, (Range, a)) (RecordMap Ident (Range, a))
    res = [(Ident, (Range, a))]
    -> Either (Ident, (Range, a)) (RecordMap Ident (Range, a))
    forall a b.
    (Show a, Ord a) =>
    [(a, b)] -> Either (a, b) (RecordMap a b)
    recordFromFieldsErr [(Ident, (Range, a))]
    ys
      ys :: [(Ident, (Range, a))]
    ys = (Named a -> (Ident, (Range, a)))
    -> [Named a] -> [(Ident, (Range, a))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ (Named (Located Range
    r Ident
    nm) a
    x) -> (Ident
    nm,(Range
    r,a
    x))) ([Named a] -> [Named a]
    forall a. [a] -> [a]
    reverse [Named a]
    xs)

    -- | Input expression are reversed
    mkEApp :: NonEmpty (Expr PName) -> ParseM (Expr PName)

    mkEApp :: NonEmpty (Expr PName) -> ParseM (Expr PName)
    mkEApp es :: NonEmpty (Expr PName)
    es@(Expr PName
    eLast :| [Expr PName]
    _) =
        do Expr PName
    f :| [Expr PName]
    xs <- Expr PName -> [Expr PName] -> ParseM (NonEmpty (Expr PName))
    cvtTypeParams Expr PName
    eFirst [Expr PName]
    rest
           Expr PName -> ParseM (Expr PName)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Expr PName, Expr PName) -> Expr PName -> Expr PName
    forall l t. (HasLoc l, AddLoc t) => l -> t -> t
    at (Expr PName
    eFirst,Expr PName
    eLast) (Expr PName -> Expr PName) -> Expr PName -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ (Expr PName -> Expr PName -> Expr PName)
    -> Expr PName -> [Expr PName] -> Expr PName
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Expr PName -> Expr PName -> Expr PName
    forall n. Expr n -> Expr n -> Expr n
    EApp Expr PName
    f [Expr PName]
    xs)

      where
      Expr PName
    eFirst :| [Expr PName]
    rest = NonEmpty (Expr PName) -> NonEmpty (Expr PName)
    forall a. NonEmpty a -> NonEmpty a
    NE.reverse NonEmpty (Expr PName)
    es

      {- Type applications are parsed as `ETypeVal (TTyApp fs)` expressions.
         Here we associate them with their corresponding functions,
         converting them into `EAppT` constructs.  For example:

         [ f, x, `{ a = 2 }, y ]
         becomes
         [ f, x ` { a = 2 }, y ]

         The parser associates field and tuple projectors that follow an
         explicit type application onto the TTyApp term, so we also
         have to unwind those projections and reapply them.  For example:

         [ f, x, `{ a = 2 }.f.2, y ]
         becomes
         [ f, (x`{ a = 2 }).f.2, y ]

      -}
      cvtTypeParams :: Expr PName -> [Expr PName] -> ParseM (NonEmpty (Expr PName))
    cvtTypeParams Expr PName
    e [] = NonEmpty (Expr PName) -> ParseM (NonEmpty (Expr PName))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Expr PName
    e Expr PName -> [Expr PName] -> NonEmpty (Expr PName)
    forall a. a -> [a] -> NonEmpty a
    :| [])
      cvtTypeParams Expr PName
    e (Expr PName
    p : [Expr PName]
    ps) =
        case Expr PName
    -> Maybe Range -> Maybe ([TypeInst PName], [Selector], Maybe Range)
    toTypeParam Expr PName
    p Maybe Range
    forall a. Maybe a
    Nothing of
          Maybe ([TypeInst PName], [Selector], Maybe Range)
    Nothing -> Expr PName -> NonEmpty (Expr PName) -> NonEmpty (Expr PName)
    forall a. a -> NonEmpty a -> NonEmpty a
    NE.cons Expr PName
    e (NonEmpty (Expr PName) -> NonEmpty (Expr PName))
    -> ParseM (NonEmpty (Expr PName)) -> ParseM (NonEmpty (Expr PName))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr PName -> [Expr PName] -> ParseM (NonEmpty (Expr PName))
    cvtTypeParams Expr PName
    p [Expr PName]
    ps

          Just ([TypeInst PName]
    fs,[Selector]
    ss,Maybe Range
    rng) ->
            if Expr PName -> Bool
    forall {n}. Expr n -> Bool
    checkAppExpr Expr PName
    e then
              let e' :: Expr PName
    e'  = (Selector -> Expr PName -> Expr PName)
    -> Expr PName -> [Selector] -> Expr PName
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((Expr PName -> Selector -> Expr PName)
    -> Selector -> Expr PName -> Expr PName
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Expr PName -> Selector -> Expr PName
    forall n. Expr n -> Selector -> Expr n
    ESel) (Expr PName -> [TypeInst PName] -> Expr PName
    forall n. Expr n -> [TypeInst n] -> Expr n
    EAppT Expr PName
    e [TypeInst PName]
    fs) [Selector]
    ss
                  e'' :: Expr PName
    e'' = case Maybe Range -> Maybe Range -> Maybe Range
    rCombMaybe (Expr PName -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc Expr PName
    e) Maybe Range
    rng of
                          Just Range
    r -> Expr PName -> Range -> Expr PName
    forall n. Expr n -> Range -> Expr n
    ELocated Expr PName
    e' Range
    r
                          Maybe Range
    Nothing -> Expr PName
    e'
               in Expr PName -> [Expr PName] -> ParseM (NonEmpty (Expr PName))
    cvtTypeParams Expr PName
    e'' [Expr PName]
    ps
            else
              Range -> [[Char]] -> ParseM (NonEmpty (Expr PName))
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage (Range -> Maybe Range -> Range
    forall a. a -> Maybe a -> a
    fromMaybe Range
    emptyRange (Expr PName -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc Expr PName
    e))
                      [ [Char]
    "Explicit type applications can only be applied to named values."
                      , [Char]
    "Unexpected: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Doc -> [Char]
    forall a. Show a => a -> [Char]
    show (Expr PName -> Doc
    forall a. PP a => a -> Doc
    pp Expr PName
    e)
                      ]

      {- Check if the given expression is a legal target for explicit type application.
         This is basically only variables, but we also allow the parenthesis and
         the phantom "located" AST node.
       -}
      checkAppExpr :: Expr n -> Bool
    checkAppExpr Expr n
    e =
        case Expr n
    e of
          ELocated Expr n
    e' Range
    _ -> Expr n -> Bool
    checkAppExpr Expr n
    e'
          EParens Expr n
    e'    -> Expr n -> Bool
    checkAppExpr Expr n
    e'
          EVar{}        -> Bool
    True
          Expr n
    _             -> Bool
    False

      {- Look under a potential chain of selectors to see if we have a TTyApp.
         If so, return the ty app information and the collected selectors
         to reapply.
       -}
      toTypeParam :: Expr PName
    -> Maybe Range -> Maybe ([TypeInst PName], [Selector], Maybe Range)
    toTypeParam Expr PName
    e Maybe Range
    mr =
        case Expr PName
    e of
          ELocated Expr PName
    e' Range
    rng -> Expr PName
    -> Maybe Range -> Maybe ([TypeInst PName], [Selector], Maybe Range)
    toTypeParam Expr PName
    e' (Maybe Range -> Maybe Range -> Maybe Range
    rCombMaybe Maybe Range
    mr (Range -> Maybe Range
    forall a. a -> Maybe a
    Just Range
    rng))
          ETypeVal Type PName
    t -> Type PName
    -> Maybe Range -> Maybe ([TypeInst PName], [Selector], Maybe Range)
    forall {a}.
    Type PName
    -> Maybe Range -> Maybe ([TypeInst PName], [a], Maybe Range)
    toTypeParam' Type PName
    t Maybe Range
    mr
          ESel Expr PName
    e' Selector
    s  -> ( \([TypeInst PName]
    fs,[Selector]
    ss,Maybe Range
    r) -> ([TypeInst PName]
    fs,Selector
    sSelector -> [Selector] -> [Selector]
    forall a. a -> [a] -> [a]
    :[Selector]
    ss,Maybe Range
    r) ) (([TypeInst PName], [Selector], Maybe Range)
     -> ([TypeInst PName], [Selector], Maybe Range))
    -> Maybe ([TypeInst PName], [Selector], Maybe Range)
    -> Maybe ([TypeInst PName], [Selector], Maybe Range)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Expr PName
    -> Maybe Range -> Maybe ([TypeInst PName], [Selector], Maybe Range)
    toTypeParam Expr PName
    e' Maybe Range
    mr
          Expr PName
    _          ->  Maybe ([TypeInst PName], [Selector], Maybe Range)
    forall a. Maybe a
    Nothing

      toTypeParam' :: Type PName
    -> Maybe Range -> Maybe ([TypeInst PName], [a], Maybe Range)
    toTypeParam' Type PName
    t Maybe Range
    mr =
        case Type PName
    t of
          TLocated Type PName
    t' Range
    rng -> Type PName
    -> Maybe Range -> Maybe ([TypeInst PName], [a], Maybe Range)
    toTypeParam' Type PName
    t' (Maybe Range -> Maybe Range -> Maybe Range
    rCombMaybe Maybe Range
    mr (Range -> Maybe Range
    forall a. a -> Maybe a
    Just Range
    rng))
          TTyApp [Named (Type PName)]
    fs -> ([TypeInst PName], [a], Maybe Range)
    -> Maybe ([TypeInst PName], [a], Maybe Range)
    forall a. a -> Maybe a
    Just ((Named (Type PName) -> TypeInst PName)
    -> [Named (Type PName)] -> [TypeInst PName]
    forall a b. (a -> b) -> [a] -> [b]
    map Named (Type PName) -> TypeInst PName
    mkTypeInst [Named (Type PName)]
    fs, [], Maybe Range
    mr)
          Type PName
    _ -> Maybe ([TypeInst PName], [a], Maybe Range)
    forall a. Maybe a
    Nothing

    unOp :: Expr PName -> Expr PName -> Expr PName
    unOp :: Expr PName -> Expr PName -> Expr PName
    unOp Expr PName
    f Expr PName
    x = (Expr PName, Expr PName) -> Expr PName -> Expr PName
    forall l t. (HasLoc l, AddLoc t) => l -> t -> t
    at (Expr PName
    f,Expr PName
    x) (Expr PName -> Expr PName) -> Expr PName -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Expr PName -> Expr PName -> Expr PName
    forall n. Expr n -> Expr n -> Expr n
    EApp Expr PName
    f Expr PName
    x

    -- Use defaultFixity as a placeholder, it will be fixed during renaming.
    binOp :: Expr PName -> Located PName -> Expr PName -> Expr PName
    binOp :: Expr PName -> LPName -> Expr PName -> Expr PName
    binOp Expr PName
    x LPName
    f Expr PName
    y = (Expr PName, Expr PName) -> Expr PName -> Expr PName
    forall l t. (HasLoc l, AddLoc t) => l -> t -> t
    at (Expr PName
    x,Expr PName
    y) (Expr PName -> Expr PName) -> Expr PName -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Expr PName -> LPName -> Fixity -> Expr PName -> Expr PName
    forall n. Expr n -> Located n -> Fixity -> Expr n -> Expr n
    EInfix Expr PName
    x LPName
    f Fixity
    defaultFixity Expr PName
    y

    -- An element type ascription is allowed to appear on one of the arguments.
    eFromTo :: Range -> Expr PName -> Maybe (Expr PName) -> Expr PName -> ParseM (Expr PName)
    eFromTo :: Range
    -> Expr PName
    -> Maybe (Expr PName)
    -> Expr PName
    -> ParseM (Expr PName)
    eFromTo Range
    r Expr PName
    e1 Maybe (Expr PName)
    e2 Expr PName
    e3 =
      case (Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e1, Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped (Expr PName -> Maybe (Expr PName, Type PName))
    -> Maybe (Expr PName) -> Maybe (Expr PName, Type PName)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe (Expr PName)
    e2, Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e3) of
        (Just (Expr PName
    e1', Type PName
    t), Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing) -> Range
    -> Expr PName
    -> Maybe (Expr PName)
    -> Expr PName
    -> Maybe (Type PName)
    -> ParseM (Expr PName)
    eFromToType Range
    r Expr PName
    e1' Maybe (Expr PName)
    e2 Expr PName
    e3 (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t)
        (Maybe (Expr PName, Type PName)
    Nothing, Just (Expr PName
    e2', Type PName
    t), Maybe (Expr PName, Type PName)
    Nothing) -> Range
    -> Expr PName
    -> Maybe (Expr PName)
    -> Expr PName
    -> Maybe (Type PName)
    -> ParseM (Expr PName)
    eFromToType Range
    r Expr PName
    e1 (Expr PName -> Maybe (Expr PName)
    forall a. a -> Maybe a
    Just Expr PName
    e2') Expr PName
    e3 (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t)
        (Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing, Just (Expr PName
    e3', Type PName
    t)) -> Range
    -> Expr PName
    -> Maybe (Expr PName)
    -> Expr PName
    -> Maybe (Type PName)
    -> ParseM (Expr PName)
    eFromToType Range
    r Expr PName
    e1 Maybe (Expr PName)
    e2 Expr PName
    e3' (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t)
        (Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing) -> Range
    -> Expr PName
    -> Maybe (Expr PName)
    -> Expr PName
    -> Maybe (Type PName)
    -> ParseM (Expr PName)
    eFromToType Range
    r Expr PName
    e1 Maybe (Expr PName)
    e2 Expr PName
    e3 Maybe (Type PName)
    forall a. Maybe a
    Nothing
        (Maybe (Expr PName, Type PName), Maybe (Expr PName, Type PName),
     Maybe (Expr PName, Type PName))
    _ -> Range -> [[Char]] -> ParseM (Expr PName)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    r [[Char]
    "A sequence enumeration may have at most one element type annotation."]

    eFromToBy :: Range -> Expr PName -> Expr PName -> Expr PName -> Bool -> ParseM (Expr PName)
    eFromToBy :: Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Bool
    -> ParseM (Expr PName)
    eFromToBy Range
    r Expr PName
    e1 Expr PName
    e2 Expr PName
    e3 Bool
    isStrictBound =
      case (Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e1, Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e2, Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e3) of
        (Just (Expr PName
    e1', Type PName
    t), Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing) -> Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToByTyped Range
    r Expr PName
    e1' Expr PName
    e2 Expr PName
    e3 (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t) Bool
    isStrictBound
        (Maybe (Expr PName, Type PName)
    Nothing, Just (Expr PName
    e2', Type PName
    t), Maybe (Expr PName, Type PName)
    Nothing) -> Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToByTyped Range
    r Expr PName
    e1 Expr PName
    e2' Expr PName
    e3 (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t) Bool
    isStrictBound
        (Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing, Just (Expr PName
    e3', Type PName
    t)) -> Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToByTyped Range
    r Expr PName
    e1 Expr PName
    e2 Expr PName
    e3' (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t) Bool
    isStrictBound
        (Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing)       -> Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToByTyped Range
    r Expr PName
    e1 Expr PName
    e2 Expr PName
    e3 Maybe (Type PName)
    forall a. Maybe a
    Nothing Bool
    isStrictBound
        (Maybe (Expr PName, Type PName), Maybe (Expr PName, Type PName),
     Maybe (Expr PName, Type PName))
    _ -> Range -> [[Char]] -> ParseM (Expr PName)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    r [[Char]
    "A sequence enumeration may have at most one element type annotation."]

    eFromToByTyped :: Range -> Expr PName -> Expr PName -> Expr PName -> Maybe (Type PName) -> Bool -> ParseM (Expr PName)
    eFromToByTyped :: Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToByTyped Range
    r Expr PName
    e1 Expr PName
    e2 Expr PName
    e3 Maybe (Type PName)
    t Bool
    isStrictBound =
      Bool
    -> Type PName
    -> Type PName
    -> Type PName
    -> Maybe (Type PName)
    -> Expr PName
    forall n.
    Bool -> Type n -> Type n -> Type n -> Maybe (Type n) -> Expr n
    EFromToBy Bool
    isStrictBound
          (Type PName
     -> Type PName -> Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Type PName)
    -> ParseM
         (Type PName -> Type PName -> Maybe (Type PName) -> Expr PName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e1
          ParseM
      (Type PName -> Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Type PName)
    -> ParseM (Type PName -> Maybe (Type PName) -> Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e2
          ParseM (Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Type PName) -> ParseM (Maybe (Type PName) -> Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e3
          ParseM (Maybe (Type PName) -> Expr PName)
    -> ParseM (Maybe (Type PName)) -> ParseM (Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe (Type PName) -> ParseM (Maybe (Type PName))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Type PName)
    t

    eFromToDownBy ::
      Range -> Expr PName -> Expr PName -> Expr PName -> Bool -> ParseM (Expr PName)
    eFromToDownBy :: Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Bool
    -> ParseM (Expr PName)
    eFromToDownBy Range
    r Expr PName
    e1 Expr PName
    e2 Expr PName
    e3 Bool
    isStrictBound =
      case (Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e1, Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e2, Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e3) of
        (Just (Expr PName
    e1', Type PName
    t), Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing) -> Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToDownByTyped Range
    r Expr PName
    e1' Expr PName
    e2 Expr PName
    e3 (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t) Bool
    isStrictBound
        (Maybe (Expr PName, Type PName)
    Nothing, Just (Expr PName
    e2', Type PName
    t), Maybe (Expr PName, Type PName)
    Nothing) -> Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToDownByTyped Range
    r Expr PName
    e1 Expr PName
    e2' Expr PName
    e3 (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t) Bool
    isStrictBound
        (Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing, Just (Expr PName
    e3', Type PName
    t)) -> Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToDownByTyped Range
    r Expr PName
    e1 Expr PName
    e2 Expr PName
    e3' (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t) Bool
    isStrictBound
        (Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing, Maybe (Expr PName, Type PName)
    Nothing)       -> Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToDownByTyped Range
    r Expr PName
    e1 Expr PName
    e2 Expr PName
    e3 Maybe (Type PName)
    forall a. Maybe a
    Nothing Bool
    isStrictBound
        (Maybe (Expr PName, Type PName), Maybe (Expr PName, Type PName),
     Maybe (Expr PName, Type PName))
    _ -> Range -> [[Char]] -> ParseM (Expr PName)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    r [[Char]
    "A sequence enumeration may have at most one element type annotation."]

    eFromToDownByTyped ::
      Range -> Expr PName -> Expr PName -> Expr PName -> Maybe (Type PName) -> Bool -> ParseM (Expr PName)
    eFromToDownByTyped :: Range
    -> Expr PName
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> Bool
    -> ParseM (Expr PName)
    eFromToDownByTyped Range
    r Expr PName
    e1 Expr PName
    e2 Expr PName
    e3 Maybe (Type PName)
    t Bool
    isStrictBound =
      Bool
    -> Type PName
    -> Type PName
    -> Type PName
    -> Maybe (Type PName)
    -> Expr PName
    forall n.
    Bool -> Type n -> Type n -> Type n -> Maybe (Type n) -> Expr n
    EFromToDownBy Bool
    isStrictBound
          (Type PName
     -> Type PName -> Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Type PName)
    -> ParseM
         (Type PName -> Type PName -> Maybe (Type PName) -> Expr PName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e1
          ParseM
      (Type PName -> Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Type PName)
    -> ParseM (Type PName -> Maybe (Type PName) -> Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e2
          ParseM (Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Type PName) -> ParseM (Maybe (Type PName) -> Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e3
          ParseM (Maybe (Type PName) -> Expr PName)
    -> ParseM (Maybe (Type PName)) -> ParseM (Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe (Type PName) -> ParseM (Maybe (Type PName))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Type PName)
    t

    asETyped :: Expr n -> Maybe (Expr n, Type n)
    asETyped :: forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped (ELocated Expr n
    e Range
    _) = Expr n -> Maybe (Expr n, Type n)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr n
    e
    asETyped (ETyped Expr n
    e Type n
    t) = (Expr n, Type n) -> Maybe (Expr n, Type n)
    forall a. a -> Maybe a
    Just (Expr n
    e, Type n
    t)
    asETyped Expr n
    _ = Maybe (Expr n, Type n)
    forall a. Maybe a
    Nothing

    eFromToType ::
      Range -> Expr PName -> Maybe (Expr PName) -> Expr PName -> Maybe (Type PName) -> ParseM (Expr PName)
    eFromToType :: Range
    -> Expr PName
    -> Maybe (Expr PName)
    -> Expr PName
    -> Maybe (Type PName)
    -> ParseM (Expr PName)
    eFromToType Range
    r Expr PName
    e1 Maybe (Expr PName)
    e2 Expr PName
    e3 Maybe (Type PName)
    t =
      Type PName
    -> Maybe (Type PName)
    -> Type PName
    -> Maybe (Type PName)
    -> Expr PName
    forall n.
    Type n -> Maybe (Type n) -> Type n -> Maybe (Type n) -> Expr n
    EFromTo (Type PName
     -> Maybe (Type PName)
     -> Type PName
     -> Maybe (Type PName)
     -> Expr PName)
    -> ParseM (Type PName)
    -> ParseM
         (Maybe (Type PName)
          -> Type PName -> Maybe (Type PName) -> Expr PName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e1
              ParseM
      (Maybe (Type PName)
       -> Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Maybe (Type PName))
    -> ParseM (Type PName -> Maybe (Type PName) -> Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Expr PName -> ParseM (Type PName))
    -> Maybe (Expr PName) -> ParseM (Maybe (Type PName))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM (Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r) Maybe (Expr PName)
    e2
              ParseM (Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Type PName) -> ParseM (Maybe (Type PName) -> Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e3
              ParseM (Maybe (Type PName) -> Expr PName)
    -> ParseM (Maybe (Type PName)) -> ParseM (Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe (Type PName) -> ParseM (Maybe (Type PName))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Type PName)
    t

    eFromToLessThan ::
      Range -> Expr PName -> Expr PName -> ParseM (Expr PName)
    eFromToLessThan :: Range -> Expr PName -> Expr PName -> ParseM (Expr PName)
    eFromToLessThan Range
    r Expr PName
    e1 Expr PName
    e2 =
      case Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e2 of
        Just (Expr PName, Type PName)
    _  -> Range -> [[Char]] -> ParseM (Expr PName)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    r [[Char]
    "The exclusive upper bound of an enumeration may not have a type annotation."]
        Maybe (Expr PName, Type PName)
    Nothing ->
          case Expr PName -> Maybe (Expr PName, Type PName)
    forall n. Expr n -> Maybe (Expr n, Type n)
    asETyped Expr PName
    e1 of
            Maybe (Expr PName, Type PName)
    Nothing      -> Range
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> ParseM (Expr PName)
    eFromToLessThanType Range
    r Expr PName
    e1  Expr PName
    e2 Maybe (Type PName)
    forall a. Maybe a
    Nothing
            Just (Expr PName
    e1',Type PName
    t) -> Range
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> ParseM (Expr PName)
    eFromToLessThanType Range
    r Expr PName
    e1' Expr PName
    e2 (Type PName -> Maybe (Type PName)
    forall a. a -> Maybe a
    Just Type PName
    t)

    eFromToLessThanType ::
      Range -> Expr PName -> Expr PName -> Maybe (Type PName) -> ParseM (Expr PName)
    eFromToLessThanType :: Range
    -> Expr PName
    -> Expr PName
    -> Maybe (Type PName)
    -> ParseM (Expr PName)
    eFromToLessThanType Range
    r Expr PName
    e1 Expr PName
    e2 Maybe (Type PName)
    t =
      Type PName -> Type PName -> Maybe (Type PName) -> Expr PName
    forall n. Type n -> Type n -> Maybe (Type n) -> Expr n
    EFromToLessThan
        (Type PName -> Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Type PName)
    -> ParseM (Type PName -> Maybe (Type PName) -> Expr PName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e1
        ParseM (Type PName -> Maybe (Type PName) -> Expr PName)
    -> ParseM (Type PName) -> ParseM (Maybe (Type PName) -> Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    e2
        ParseM (Maybe (Type PName) -> Expr PName)
    -> ParseM (Maybe (Type PName)) -> ParseM (Expr PName)
    forall a b. ParseM (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe (Type PName) -> ParseM (Maybe (Type PName))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Type PName)
    t

    exprToNumT :: Range -> Expr PName -> ParseM (Type PName)
    exprToNumT :: Range -> Expr PName -> ParseM (Type PName)
    exprToNumT Range
    r Expr PName
    expr =
      case Expr PName -> Maybe (Type PName)
    translateExprToNumT Expr PName
    expr of
        Just Type PName
    t -> Type PName -> ParseM (Type PName)
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type PName
    t
        Maybe (Type PName)
    Nothing -> ParseM (Type PName)
    forall a. ParseM a
    bad
      where
      bad :: ParseM a
    bad = Range -> [[Char]] -> ParseM a
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage (Range -> Maybe Range -> Range
    forall a. a -> Maybe a -> a
    fromMaybe Range
    r (Expr PName -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc Expr PName
    expr))
            [ [Char]
    "The boundaries of .. sequences should be valid numeric types."
            , [Char]
    "The expression `" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Doc -> [Char]
    forall a. Show a => a -> [Char]
    show (Expr PName -> Doc
    forall a. PP a => a -> Doc
    pp Expr PName
    expr) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "` is not."
            ]

    -- | WARNING: This is a bit of a hack.
    -- It is used to represent anonymous type applications.
    anonTyApp :: Maybe Range -> [Type PName] -> Type PName
    anonTyApp :: Maybe Range -> [Type PName] -> Type PName
    anonTyApp ~(Just Range
    r) [Type PName]
    ts = Type PName -> Range -> Type PName
    forall n. Type n -> Range -> Type n
    TLocated ([Named (Type PName)] -> Type PName
    forall n. [Named (Type n)] -> Type n
    TTyApp ((Type PName -> Named (Type PName))
    -> [Type PName] -> [Named (Type PName)]
    forall a b. (a -> b) -> [a] -> [b]
    map Type PName -> Named (Type PName)
    forall {a}. a -> Named a
    toField [Type PName]
    ts)) Range
    r
      where noName :: Located Ident
    noName    = Located { srcRange :: Range
    srcRange = Range
    r, thing :: Ident
    thing = Text -> Ident
    mkIdent ([Char] -> Text
    T.pack [Char]
    "") }
            toField :: a -> Named a
    toField a
    t = Named { name :: Located Ident
    name = Located Ident
    noName, value :: a
    value = a
    t }

    exportDecl :: Maybe (Located Text) -> ExportType -> Decl PName -> TopDecl PName
    exportDecl :: Maybe (Located Text) -> ExportType -> Decl PName -> TopDecl PName
    exportDecl Maybe (Located Text)
    mbDoc ExportType
    e Decl PName
    d = TopLevel (Decl PName) -> TopDecl PName
    forall name. TopLevel (Decl name) -> TopDecl name
    Decl TopLevel { tlExport :: ExportType
    tlExport = ExportType
    e
                                         , tlDoc :: Maybe (Located Text)
    tlDoc    = Maybe (Located Text)
    mbDoc
                                         , tlValue :: Decl PName
    tlValue  = Decl PName
    d }

    exportNewtype :: ExportType -> Maybe (Located Text) -> Newtype PName ->
                                                                TopDecl PName
    exportNewtype :: ExportType
    -> Maybe (Located Text) -> Newtype PName -> TopDecl PName
    exportNewtype ExportType
    e Maybe (Located Text)
    d Newtype PName
    n = TopLevel (Newtype PName) -> TopDecl PName
    forall name. TopLevel (Newtype name) -> TopDecl name
    TDNewtype TopLevel { tlExport :: ExportType
    tlExport = ExportType
    e
                                             , tlDoc :: Maybe (Located Text)
    tlDoc    = Maybe (Located Text)
    d
                                             , tlValue :: Newtype PName
    tlValue  = Newtype PName
    n }

    exportModule :: Maybe (Located Text) -> NestedModule PName -> TopDecl PName
    exportModule :: Maybe (Located Text) -> NestedModule PName -> TopDecl PName
    exportModule Maybe (Located Text)
    mbDoc NestedModule PName
    m = TopLevel (NestedModule PName) -> TopDecl PName
    forall name. TopLevel (NestedModule name) -> TopDecl name
    DModule TopLevel { tlExport :: ExportType
    tlExport = ExportType
    Public
                                            , tlDoc :: Maybe (Located Text)
    tlDoc    = Maybe (Located Text)
    mbDoc
                                            , tlValue :: NestedModule PName
    tlValue  = NestedModule PName
    m }

    mkParFun :: Maybe (Located Text) ->
                Located PName ->
                Schema PName ->
                ParamDecl PName
    mkParFun :: Maybe (Located Text) -> LPName -> Schema PName -> ParamDecl PName
    mkParFun Maybe (Located Text)
    mbDoc LPName
    n Schema PName
    s = ParameterFun PName -> ParamDecl PName
    forall name. ParameterFun name -> ParamDecl name
    DParameterFun ParameterFun { pfName :: LPName
    pfName = LPName
    n
                                                    , pfSchema :: Schema PName
    pfSchema = Schema PName
    s
                                                    , pfDoc :: Maybe Text
    pfDoc = Located Text -> Text
    forall a. Located a -> a
    thing (Located Text -> Text) -> Maybe (Located Text) -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Located Text)
    mbDoc
                                                    , pfFixity :: Maybe Fixity
    pfFixity = Maybe Fixity
    forall a. Maybe a
    Nothing
                                                    }

    mkParType :: Maybe (Located Text) ->
                 Located PName ->
                 Located Kind ->
                 ParseM (ParamDecl PName)
    mkParType :: Maybe (Located Text)
    -> LPName -> Located Kind -> ParseM (ParamDecl PName)
    mkParType Maybe (Located Text)
    mbDoc LPName
    n Located Kind
    k =
      do Int
    num <- (Config -> Position -> S -> Either ParseError (Int, S))
    -> ParseM Int
    forall a.
    (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    P ((Config -> Position -> S -> Either ParseError (Int, S))
     -> ParseM Int)
    -> (Config -> Position -> S -> Either ParseError (Int, S))
    -> ParseM Int
    forall a b. (a -> b) -> a -> b
    $ \Config
    _ Position
    _ S
    s -> let nu :: Int
    nu = S -> Int
    sNextTyParamNum S
    s
                              in (Int, S) -> Either ParseError (Int, S)
    forall a b. b -> Either a b
    Right (Int
    nu, S
    s { sNextTyParamNum :: Int
    sNextTyParamNum = Int
    nu Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 })
         ParamDecl PName -> ParseM (ParamDecl PName)
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ParameterType PName -> ParamDecl PName
    forall name. ParameterType name -> ParamDecl name
    DParameterType
                 ParameterType { ptName :: LPName
    ptName    = LPName
    n
                               , ptKind :: Kind
    ptKind    = Located Kind -> Kind
    forall a. Located a -> a
    thing Located Kind
    k
                               , ptDoc :: Maybe Text
    ptDoc     = Located Text -> Text
    forall a. Located a -> a
    thing (Located Text -> Text) -> Maybe (Located Text) -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Located Text)
    mbDoc
                               , ptFixity :: Maybe Fixity
    ptFixity  = Maybe Fixity
    forall a. Maybe a
    Nothing
                               , ptNumber :: Int
    ptNumber  = Int
    num
                               })

    changeExport :: ExportType -> [TopDecl PName] -> [TopDecl PName]
    changeExport :: ExportType -> [TopDecl PName] -> [TopDecl PName]
    changeExport ExportType
    e = (TopDecl PName -> TopDecl PName)
    -> [TopDecl PName] -> [TopDecl PName]
    forall a b. (a -> b) -> [a] -> [b]
    map TopDecl PName -> TopDecl PName
    forall {name}. TopDecl name -> TopDecl name
    change
      where
      change :: TopDecl name -> TopDecl name
    change TopDecl name
    decl =
        case TopDecl name
    decl of
          Decl TopLevel (Decl name)
    d                  -> TopLevel (Decl name) -> TopDecl name
    forall name. TopLevel (Decl name) -> TopDecl name
    Decl      TopLevel (Decl name)
    d { tlExport :: ExportType
    tlExport = ExportType
    e }
          DPrimType TopLevel (PrimType name)
    t             -> TopLevel (PrimType name) -> TopDecl name
    forall name. TopLevel (PrimType name) -> TopDecl name
    DPrimType TopLevel (PrimType name)
    t { tlExport :: ExportType
    tlExport = ExportType
    e }
          TDNewtype TopLevel (Newtype name)
    n             -> TopLevel (Newtype name) -> TopDecl name
    forall name. TopLevel (Newtype name) -> TopDecl name
    TDNewtype TopLevel (Newtype name)
    n { tlExport :: ExportType
    tlExport = ExportType
    e }
          DModule TopLevel (NestedModule name)
    m               -> TopLevel (NestedModule name) -> TopDecl name
    forall name. TopLevel (NestedModule name) -> TopDecl name
    DModule   TopLevel (NestedModule name)
    m { tlExport :: ExportType
    tlExport = ExportType
    e }
          DModParam {}            -> TopDecl name
    decl
          Include{}               -> TopDecl name
    decl
          DImport{}               -> TopDecl name
    decl
          DParamDecl{}            -> TopDecl name
    decl
          DInterfaceConstraint {} -> TopDecl name
    decl

    mkTypeInst :: Named (Type PName) -> TypeInst PName
    mkTypeInst :: Named (Type PName) -> TypeInst PName
    mkTypeInst Named (Type PName)
    x | Ident -> Bool
    nullIdent (Located Ident -> Ident
    forall a. Located a -> a
    thing (Named (Type PName) -> Located Ident
    forall a. Named a -> Located Ident
    name Named (Type PName)
    x)) = Type PName -> TypeInst PName
    forall name. Type name -> TypeInst name
    PosInst (Named (Type PName) -> Type PName
    forall a. Named a -> a
    value Named (Type PName)
    x)
                 | Bool
    otherwise                  = Named (Type PName) -> TypeInst PName
    forall name. Named (Type name) -> TypeInst name
    NamedInst Named (Type PName)
    x

    mkTParam :: Located Ident -> Maybe Kind -> ParseM (TParam PName)
    mkTParam :: Located Ident -> Maybe Kind -> ParseM (TParam PName)
    mkTParam Located { srcRange :: forall a. Located a -> Range
    srcRange = Range
    rng, thing :: forall a. Located a -> a
    thing = Ident
    n } Maybe Kind
    k
      | Ident
    n Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    widthIdent = Range -> [[Char]] -> ParseM (TParam PName)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    rng [[Char]
    "`width` is not a valid type parameter name."]
      | Bool
    otherwise       = TParam PName -> ParseM (TParam PName)
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PName -> Maybe Kind -> Maybe Range -> TParam PName
    forall n. n -> Maybe Kind -> Maybe Range -> TParam n
    TParam (Ident -> PName
    mkUnqual Ident
    n) Maybe Kind
    k (Range -> Maybe Range
    forall a. a -> Maybe a
    Just Range
    rng))

    mkTySyn :: Type PName -> Type PName -> ParseM (Decl PName)
    mkTySyn :: Type PName -> Type PName -> ParseM (Decl PName)
    mkTySyn Type PName
    thead Type PName
    tdef =
      do (LPName
    nm,[TParam PName]
    params) <- Type PName -> ParseM (LPName, [TParam PName])
    typeToDecl Type PName
    thead
         Decl PName -> ParseM (Decl PName)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TySyn PName -> Decl PName
    forall name. TySyn name -> Decl name
    DType (LPName
    -> Maybe Fixity -> [TParam PName] -> Type PName -> TySyn PName
    forall n.
    Located n -> Maybe Fixity -> [TParam n] -> Type n -> TySyn n
    TySyn LPName
    nm Maybe Fixity
    forall a. Maybe a
    Nothing [TParam PName]
    params Type PName
    tdef))

    mkPropSyn :: Type PName -> Type PName -> ParseM (Decl PName)
    mkPropSyn :: Type PName -> Type PName -> ParseM (Decl PName)
    mkPropSyn Type PName
    thead Type PName
    tdef =
      do (LPName
    nm,[TParam PName]
    params) <- Type PName -> ParseM (LPName, [TParam PName])
    typeToDecl Type PName
    thead
         [Prop PName]
    ps          <- Located [Prop PName] -> [Prop PName]
    forall a. Located a -> a
    thing (Located [Prop PName] -> [Prop PName])
    -> ParseM (Located [Prop PName]) -> ParseM [Prop PName]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type PName -> ParseM (Located [Prop PName])
    mkProp Type PName
    tdef
         Decl PName -> ParseM (Decl PName)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PropSyn PName -> Decl PName
    forall name. PropSyn name -> Decl name
    DProp (LPName
    -> Maybe Fixity -> [TParam PName] -> [Prop PName] -> PropSyn PName
    forall n.
    Located n -> Maybe Fixity -> [TParam n] -> [Prop n] -> PropSyn n
    PropSyn LPName
    nm Maybe Fixity
    forall a. Maybe a
    Nothing [TParam PName]
    params [Prop PName]
    ps))

    mkNewtype ::
      Type PName ->
      Located (RecordMap Ident (Range, Type PName)) ->
      ParseM (Newtype PName)
    mkNewtype :: Type PName
    -> Located (RecordMap Ident (Range, Type PName))
    -> ParseM (Newtype PName)
    mkNewtype Type PName
    thead Located (RecordMap Ident (Range, Type PName))
    def =
      do (LPName
    nm,[TParam PName]
    params) <- Type PName -> ParseM (LPName, [TParam PName])
    typeToDecl Type PName
    thead
         Newtype PName -> ParseM (Newtype PName)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (LPName
    -> [TParam PName]
    -> PName
    -> RecordMap Ident (Range, Type PName)
    -> Newtype PName
    forall name.
    Located name
    -> [TParam name] -> name -> Rec (Type name) -> Newtype name
    Newtype LPName
    nm [TParam PName]
    params (LPName -> PName
    forall a. Located a -> a
    thing LPName
    nm) (Located (RecordMap Ident (Range, Type PName))
    -> RecordMap Ident (Range, Type PName)
    forall a. Located a -> a
    thing Located (RecordMap Ident (Range, Type PName))
    def))

    typeToDecl :: Type PName -> ParseM (Located PName, [TParam PName])
    typeToDecl :: Type PName -> ParseM (LPName, [TParam PName])
    typeToDecl Type PName
    ty0 =
      case Type PName
    ty0 of
        TLocated Type PName
    ty Range
    loc -> Range -> Type PName -> ParseM (LPName, [TParam PName])
    goD Range
    loc Type PName
    ty
        Type PName
    _ -> [Char] -> [[Char]] -> ParseM (LPName, [TParam PName])
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "typeToDecl" [[Char]
    "Type location is missing."]

      where
      bad :: Range -> ParseM a
    bad Range
    loc  = Range -> [[Char]] -> ParseM a
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    loc [[Char]
    "Invalid type declaration"]
      badP :: Range -> ParseM a
    badP Range
    loc = Range -> [[Char]] -> ParseM a
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    loc [[Char]
    "Invalid declaration parameter"]

      goN :: Range -> PName -> ParseM ()
    goN Range
    loc PName
    n =
        case PName
    n of
          UnQual {} -> () -> ParseM ()
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
          PName
    _         -> Range -> [[Char]] -> ParseM ()
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    loc [[Char]
    "Invalid declaration name"]

      goP :: Range -> Type PName -> ParseM (TParam PName)
    goP Range
    loc Type PName
    ty =
        case Type PName
    ty of
          TLocated Type PName
    ty1 Range
    loc1 -> Range -> Type PName -> ParseM (TParam PName)
    goP Range
    loc1 Type PName
    ty1

          TUser PName
    f [] ->
            do Range -> PName -> ParseM ()
    goN Range
    loc PName
    f
               TParam PName -> ParseM (TParam PName)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TParam { tpName :: PName
    tpName = PName
    f, tpKind :: Maybe Kind
    tpKind = Maybe Kind
    forall a. Maybe a
    Nothing, tpRange :: Maybe Range
    tpRange = Range -> Maybe Range
    forall a. a -> Maybe a
    Just Range
    loc }

          TParens Type PName
    t Maybe Kind
    mb ->
            case Maybe Kind
    mb of
              Maybe Kind
    Nothing -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
              Just Kind
    k  ->
                do TParam PName
    p <- Range -> Type PName -> ParseM (TParam PName)
    goP Range
    loc Type PName
    t
                   case TParam PName -> Maybe Kind
    forall n. TParam n -> Maybe Kind
    tpKind TParam PName
    p of
                     Maybe Kind
    Nothing -> TParam PName -> ParseM (TParam PName)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TParam PName
    p { tpKind :: Maybe Kind
    tpKind = Kind -> Maybe Kind
    forall a. a -> Maybe a
    Just Kind
    k }
                     Just {} -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc

          TInfix {}     -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TUser {}      -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TFun {}       -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TSeq {}       -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TBit {}       -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TNum {}       -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TChar {}      -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TRecord {}    -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TWild {}      -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TTyApp {}     -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc
          TTuple {}     -> Range -> ParseM (TParam PName)
    forall {a}. Range -> ParseM a
    badP Range
    loc

      goD :: Range -> Type PName -> ParseM (LPName, [TParam PName])
    goD Range
    loc Type PName
    ty =
        case Type PName
    ty of

          TLocated Type PName
    ty1 Range
    loc1 -> Range -> Type PName -> ParseM (LPName, [TParam PName])
    goD Range
    loc1 Type PName
    ty1

          TUser PName
    f [Type PName]
    ts ->
            do Range -> PName -> ParseM ()
    goN Range
    loc PName
    f
               [TParam PName]
    ps <- (Type PName -> ParseM (TParam PName))
    -> [Type PName] -> ParseM [TParam PName]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Range -> Type PName -> ParseM (TParam PName)
    goP Range
    loc) [Type PName]
    ts
               (LPName, [TParam PName]) -> ParseM (LPName, [TParam PName])
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Located { thing :: PName
    thing = PName
    f, srcRange :: Range
    srcRange = Range
    loc },[TParam PName]
    ps)

          TInfix Type PName
    l LPName
    f Fixity
    _ Type PName
    r ->
            do Range -> PName -> ParseM ()
    goN (LPName -> Range
    forall a. Located a -> Range
    srcRange LPName
    f) (LPName -> PName
    forall a. Located a -> a
    thing LPName
    f)
               TParam PName
    a  <- Range -> Type PName -> ParseM (TParam PName)
    goP Range
    loc Type PName
    l
               TParam PName
    b  <- Range -> Type PName -> ParseM (TParam PName)
    goP Range
    loc Type PName
    r
               (LPName, [TParam PName]) -> ParseM (LPName, [TParam PName])
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (LPName
    f,[TParam PName
    a,TParam PName
    b])

          TFun {}       -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc
          TSeq {}       -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc
          TBit {}       -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc
          TNum {}       -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc
          TChar {}      -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc
          TRecord {}    -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc
          TWild {}      -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc
          TTyApp {}     -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc
          TTuple {}     -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc
          TParens {}    -> Range -> ParseM (LPName, [TParam PName])
    forall {a}. Range -> ParseM a
    bad Range
    loc

    polyTerm :: Range -> Integer -> Integer -> ParseM (Bool, Integer)
    polyTerm :: Range -> Integer -> Integer -> ParseM (Bool, Integer)
    polyTerm Range
    rng Integer
    k Integer
    p
      | Integer
    k Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    0          = (Bool, Integer) -> ParseM (Bool, Integer)
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, Integer
    p)
      | Integer
    k Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    1          = (Bool, Integer) -> ParseM (Bool, Integer)
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Integer
    p)
      | Bool
    otherwise       = Range -> [[Char]] -> ParseM (Bool, Integer)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    rng [[Char]
    "Invalid polynomial coefficient"]

    mkPoly :: Range -> [ (Bool,Integer) ] -> ParseM (Expr PName)
    mkPoly :: Range -> [(Bool, Integer)] -> ParseM (Expr PName)
    mkPoly Range
    rng [(Bool, Integer)]
    terms
      | Integer
    w Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int
    forall a. Bounded a => a
    maxBound :: Int) = Integer -> [Int] -> ParseM (Expr PName)
    mk Integer
    0 ((Integer -> Int) -> [Integer] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger [Integer]
    bits)
      | Bool
    otherwise = Range -> [[Char]] -> ParseM (Expr PName)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    rng [[Char]
    "Polynomial literal too large: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Integer -> [Char]
    forall a. Show a => a -> [Char]
    show Integer
    w]

      where
      w :: Integer
    w    = case [(Bool, Integer)]
    terms of
               [] -> Integer
    0
               [(Bool, Integer)]
    _  -> Integer
    1 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + [Integer] -> Integer
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (((Bool, Integer) -> Integer) -> [(Bool, Integer)] -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, Integer) -> Integer
    forall a b. (a, b) -> b
    snd [(Bool, Integer)]
    terms)

      bits :: [Integer]
    bits = [ Integer
    n | (Bool
    True,Integer
    n) <- [(Bool, Integer)]
    terms ]

      mk :: Integer -> [Int] -> ParseM (Expr PName)
      mk :: Integer -> [Int] -> ParseM (Expr PName)
    mk Integer
    res [] = Expr PName -> ParseM (Expr PName)
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr PName -> ParseM (Expr PName))
    -> Expr PName -> ParseM (Expr PName)
    forall a b. (a -> b) -> a -> b
    $ Literal -> Expr PName
    forall n. Literal -> Expr n
    ELit (Literal -> Expr PName) -> Literal -> Expr PName
    forall a b. (a -> b) -> a -> b
    $ Integer -> NumInfo -> Literal
    ECNum Integer
    res (Int -> NumInfo
    PolyLit (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    w :: Int))

      mk Integer
    res (Int
    n : [Int]
    ns)
        | Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Integer
    res Int
    n = Range -> [[Char]] -> ParseM (Expr PName)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    rng
                           [[Char]
    "Polynomial contains multiple terms with exponent " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n]
        | Bool
    otherwise     = Integer -> [Int] -> ParseM (Expr PName)
    mk (Integer -> Int -> Integer
    forall a. Bits a => a -> Int -> a
    setBit Integer
    res Int
    n) [Int]
    ns

    -- NOTE: The list of patterns is reversed!
    mkProperty :: LPName -> [Pattern PName] -> Expr PName -> Decl PName
    mkProperty :: LPName -> [Pattern PName] -> Expr PName -> Decl PName
    mkProperty LPName
    f [Pattern PName]
    ps Expr PName
    e = (LPName, Expr PName) -> Decl PName -> Decl PName
    forall l t. (HasLoc l, AddLoc t) => l -> t -> t
    at (LPName
    f,Expr PName
    e) (Decl PName -> Decl PName) -> Decl PName -> Decl PName
    forall a b. (a -> b) -> a -> b
    $
                        Bind PName -> Decl PName
    forall name. Bind name -> Decl name
    DBind Bind { bName :: LPName
    bName       = LPName
    f
                                   , bParams :: [Pattern PName]
    bParams     = [Pattern PName] -> [Pattern PName]
    forall a. [a] -> [a]
    reverse [Pattern PName]
    ps
                                   , 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    = [Pragma
    PragmaProperty]
                                   , bMono :: Bool
    bMono       = Bool
    False
                                   , bInfix :: Bool
    bInfix      = Bool
    False
                                   , bFixity :: Maybe Fixity
    bFixity     = Maybe Fixity
    forall a. Maybe a
    Nothing
                                   , bDoc :: Maybe Text
    bDoc        = Maybe Text
    forall a. Maybe a
    Nothing
                                   , bExport :: ExportType
    bExport     = ExportType
    Public
                                   }

    -- NOTE: The lists of patterns are reversed!
    mkIndexedDecl ::
      LPName -> ([Pattern PName], [Pattern PName]) -> Expr PName -> Decl PName
    mkIndexedDecl :: LPName
    -> ([Pattern PName], [Pattern PName]) -> Expr PName -> Decl PName
    mkIndexedDecl LPName
    f ([Pattern PName]
    ps, [Pattern PName]
    ixs) Expr PName
    e =
      Bind PName -> Decl PName
    forall name. Bind name -> Decl name
    DBind Bind { bName :: LPName
    bName       = LPName
    f
                 , bParams :: [Pattern PName]
    bParams     = [Pattern PName] -> [Pattern PName]
    forall a. [a] -> [a]
    reverse [Pattern PName]
    ps
                 , 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
    rhs))
                 , 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 Text
    bDoc        = Maybe Text
    forall a. Maybe a
    Nothing
                 , bExport :: ExportType
    bExport     = ExportType
    Public
                 }
      where
        rhs :: Expr PName
        rhs :: Expr PName
    rhs = [Pattern PName] -> Expr PName -> Expr PName
    mkGenerate ([Pattern PName] -> [Pattern PName]
    forall a. [a] -> [a]
    reverse [Pattern PName]
    ixs) Expr PName
    e

    -- NOTE: The lists of patterns are reversed!
    mkPropGuardsDecl ::
      LPName ->
      ([Pattern PName], [Pattern PName]) ->
      [PropGuardCase PName] ->
      ParseM (Decl PName)
    mkPropGuardsDecl :: LPName
    -> ([Pattern PName], [Pattern PName])
    -> [PropGuardCase PName]
    -> ParseM (Decl PName)
    mkPropGuardsDecl LPName
    f ([Pattern PName]
    ps, [Pattern PName]
    ixs) [PropGuardCase PName]
    guards =
      do Bool -> ParseM () -> ParseM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([Pattern PName] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Pattern PName]
    ixs) (ParseM () -> ParseM ()) -> ParseM () -> ParseM ()
    forall a b. (a -> b) -> a -> b
    $
          Range -> [[Char]] -> ParseM ()
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage (LPName -> Range
    forall a. Located a -> Range
    srcRange LPName
    f)
                      [[Char]
    "Indexed sequence definitions may not use constraint guards"]
         let gs :: [PropGuardCase PName]
    gs  = [PropGuardCase PName] -> [PropGuardCase PName]
    forall a. [a] -> [a]
    reverse [PropGuardCase PName]
    guards
         Decl PName -> ParseM (Decl PName)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Decl PName -> ParseM (Decl PName))
    -> Decl PName -> ParseM (Decl PName)
    forall a b. (a -> b) -> a -> b
    $
           Bind PName -> Decl PName
    forall name. Bind name -> Decl name
    DBind Bind { bName :: LPName
    bName       = LPName
    f
                      , bParams :: [Pattern PName]
    bParams     = [Pattern PName] -> [Pattern PName]
    forall a. [a] -> [a]
    reverse [Pattern PName]
    ps
                      , bDef :: Located (BindDef PName)
    bDef        = Range -> BindDef PName -> Located (BindDef PName)
    forall a. Range -> a -> Located a
    Located (LPName -> Range
    forall a. Located a -> Range
    srcRange LPName
    f) ([PropGuardCase PName] -> BindDef PName
    forall name. [PropGuardCase name] -> BindDef name
    DPropGuards [PropGuardCase PName]
    gs)
                      , 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 Text
    bDoc        = Maybe Text
    forall a. Maybe a
    Nothing
                      , bExport :: ExportType
    bExport     = ExportType
    Public
                      }

    mkConstantPropGuardsDecl ::
      LPName -> [PropGuardCase PName] -> ParseM (Decl PName)
    mkConstantPropGuardsDecl :: LPName -> [PropGuardCase PName] -> ParseM (Decl PName)
    mkConstantPropGuardsDecl LPName
    f [PropGuardCase PName]
    guards =
      LPName
    -> ([Pattern PName], [Pattern PName])
    -> [PropGuardCase PName]
    -> ParseM (Decl PName)
    mkPropGuardsDecl LPName
    f ([],[]) [PropGuardCase PName]
    guards

    -- NOTE: The lists of patterns are reversed!
    mkIndexedExpr :: ([Pattern PName], [Pattern PName]) -> Expr PName -> Expr PName
    mkIndexedExpr :: ([Pattern PName], [Pattern PName]) -> Expr PName -> Expr PName
    mkIndexedExpr ([Pattern PName]
    ps, [Pattern PName]
    ixs) Expr PName
    body
      | [Pattern PName] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Pattern PName]
    ps = [Pattern PName] -> Expr PName -> Expr PName
    mkGenerate ([Pattern PName] -> [Pattern PName]
    forall a. [a] -> [a]
    reverse [Pattern PName]
    ixs) Expr PName
    body
      | Bool
    otherwise = FunDesc PName -> [Pattern PName] -> Expr PName -> Expr PName
    forall n. FunDesc n -> [Pattern n] -> Expr n -> Expr n
    EFun FunDesc PName
    forall n. FunDesc n
    emptyFunDesc ([Pattern PName] -> [Pattern PName]
    forall a. [a] -> [a]
    reverse [Pattern PName]
    ps) ([Pattern PName] -> Expr PName -> Expr PName
    mkGenerate ([Pattern PName] -> [Pattern PName]
    forall a. [a] -> [a]
    reverse [Pattern PName]
    ixs) Expr PName
    body)

    mkGenerate :: [Pattern PName] -> Expr PName -> Expr PName
    mkGenerate :: [Pattern PName] -> Expr PName -> Expr PName
    mkGenerate [Pattern PName]
    pats Expr PName
    body =
      (Pattern PName -> Expr PName -> Expr PName)
    -> Expr PName -> [Pattern PName] -> Expr PName
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Pattern PName
    pat Expr PName
    e -> Expr PName -> Expr PName
    forall n. Expr n -> Expr n
    EGenerate (FunDesc PName -> [Pattern PName] -> Expr PName -> Expr PName
    forall n. FunDesc n -> [Pattern n] -> Expr n -> Expr n
    EFun FunDesc PName
    forall n. FunDesc n
    emptyFunDesc [Pattern PName
    pat] Expr PName
    e)) Expr PName
    body [Pattern PName]
    pats

    mkIf :: [(Expr PName, Expr PName)] -> Expr PName -> Expr PName
    mkIf :: [(Expr PName, Expr PName)] -> Expr PName -> Expr PName
    mkIf [(Expr PName, Expr PName)]
    ifThens Expr PName
    theElse = ((Expr PName, Expr PName) -> Expr PName -> Expr PName)
    -> Expr PName -> [(Expr PName, Expr PName)] -> Expr PName
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Expr PName, Expr PName) -> Expr PName -> Expr PName
    forall {n}. (Expr n, Expr n) -> Expr n -> Expr n
    addIfThen Expr PName
    theElse [(Expr PName, Expr PName)]
    ifThens
        where
        addIfThen :: (Expr n, Expr n) -> Expr n -> Expr n
    addIfThen (Expr n
    cond, Expr n
    doexpr) Expr n
    elseExpr = Expr n -> Expr n -> Expr n -> Expr n
    forall n. Expr n -> Expr n -> Expr n -> Expr n
    EIf Expr n
    cond Expr n
    doexpr Expr n
    elseExpr

    mkPrimDecl :: Maybe (Located Text) -> LPName -> Schema PName -> [TopDecl PName]
    mkPrimDecl :: Maybe (Located Text) -> LPName -> Schema PName -> [TopDecl PName]
    mkPrimDecl = BindDef PName
    -> Maybe (Located Text)
    -> LPName
    -> Schema PName
    -> [TopDecl PName]
    mkNoImplDecl BindDef PName
    forall name. BindDef name
    DPrim

    mkForeignDecl ::
      Maybe (Located Text) -> LPName -> Schema PName -> ParseM [TopDecl PName]
    mkForeignDecl :: Maybe (Located Text)
    -> LPName -> Schema PName -> ParseM [TopDecl PName]
    mkForeignDecl Maybe (Located Text)
    mbDoc LPName
    nm Schema PName
    ty =
      do let txt :: [Char]
    txt = Ident -> [Char]
    unpackIdent (PName -> Ident
    getIdent (LPName -> PName
    forall a. Located a -> a
    thing LPName
    nm))
         Bool -> ParseM () -> ParseM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ((Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isOk [Char]
    txt)
           (Range -> [[Char]] -> ParseM ()
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage (LPName -> Range
    forall a. Located a -> Range
    srcRange LPName
    nm)
                [ [Char]
    "`" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    txt [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "` is not a valid foreign name."
                , [Char]
    "The name should contain only alpha-numeric characters or '_'."
                ])
         [TopDecl PName] -> ParseM [TopDecl PName]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (BindDef PName
    -> Maybe (Located Text)
    -> LPName
    -> Schema PName
    -> [TopDecl PName]
    mkNoImplDecl BindDef PName
    forall name. BindDef name
    DForeign Maybe (Located Text)
    mbDoc LPName
    nm Schema PName
    ty)
      where
      isOk :: Char -> Bool
    isOk Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_' Bool -> Bool -> Bool
    || Char -> Bool
    isAlphaNum Char
    c

    -- | Generate a signature and a binding for value declarations with no
    -- implementation (i.e. primitive or foreign declarations).  The reason for
    -- generating both instead of just adding the signature at this point is that it
    -- means the declarations don't need to be treated differently in the noPat
    -- pass.  This is also the reason we add the doc to the TopLevel constructor,
    -- instead of just place it on the binding directly.  A better solution might be
    -- to just have a different constructor for primitives and foreigns.
    mkNoImplDecl :: BindDef PName
      -> Maybe (Located Text) -> LPName -> Schema PName -> [TopDecl PName]
    mkNoImplDecl :: BindDef PName
    -> Maybe (Located Text)
    -> LPName
    -> Schema PName
    -> [TopDecl PName]
    mkNoImplDecl BindDef PName
    def Maybe (Located Text)
    mbDoc LPName
    ln Schema PName
    sig =
      [ Maybe (Located Text) -> ExportType -> Decl PName -> TopDecl PName
    exportDecl Maybe (Located Text)
    mbDoc ExportType
    Public
        (Decl PName -> TopDecl PName) -> Decl PName -> TopDecl PName
    forall a b. (a -> b) -> a -> b
    $ Bind PName -> Decl PName
    forall name. Bind name -> Decl name
    DBind Bind { bName :: LPName
    bName      = LPName
    ln
                     , bParams :: [Pattern PName]
    bParams    = []
                     , bDef :: Located (BindDef PName)
    bDef       = Schema PName -> Located (BindDef PName) -> Located (BindDef PName)
    forall l t. (HasLoc l, AddLoc t) => l -> t -> t
    at Schema PName
    sig (Range -> BindDef PName -> Located (BindDef PName)
    forall a. Range -> a -> Located a
    Located Range
    emptyRange BindDef PName
    def)
                     , bSignature :: Maybe (Schema PName)
    bSignature = Maybe (Schema PName)
    forall a. Maybe a
    Nothing
                     , bPragmas :: [Pragma]
    bPragmas   = []
                     , bMono :: Bool
    bMono      = Bool
    False
                     , bInfix :: Bool
    bInfix     = Ident -> Bool
    isInfixIdent (PName -> Ident
    getIdent (LPName -> PName
    forall a. Located a -> a
    thing LPName
    ln))
                     , bFixity :: Maybe Fixity
    bFixity    = Maybe Fixity
    forall a. Maybe a
    Nothing
                     , bDoc :: Maybe Text
    bDoc       = Maybe Text
    forall a. Maybe a
    Nothing
                     , bExport :: ExportType
    bExport    = ExportType
    Public
                     }
      , Maybe (Located Text) -> ExportType -> Decl PName -> TopDecl PName
    exportDecl Maybe (Located Text)
    forall a. Maybe a
    Nothing ExportType
    Public
        (Decl PName -> TopDecl PName) -> Decl PName -> TopDecl PName
    forall a b. (a -> b) -> a -> b
    $ [LPName] -> Schema PName -> Decl PName
    forall name. [Located name] -> Schema name -> Decl name
    DSignature [LPName
    ln] Schema PName
    sig
      ]

    mkPrimTypeDecl ::
      Maybe (Located Text) ->
      Schema PName ->
      Located Kind ->
      ParseM [TopDecl PName]
    mkPrimTypeDecl :: Maybe (Located Text)
    -> Schema PName -> Located Kind -> ParseM [TopDecl PName]
    mkPrimTypeDecl Maybe (Located Text)
    mbDoc (Forall [TParam PName]
    as [Prop PName]
    qs Type PName
    st ~(Just Range
    schema_rng)) Located Kind
    finK =
      case Range -> Type PName -> Maybe (LPName, [LPName])
    forall {a}.
    Eq a =>
    Range -> Type a -> Maybe (Located a, [Located a])
    splitT Range
    schema_rng Type PName
    st of
        Just (LPName
    n,[LPName]
    xs) ->
          do [(PName, (TParam PName, Kind))]
    vs <- (TParam PName -> ParseM (PName, (TParam PName, Kind)))
    -> [TParam PName] -> ParseM [(PName, (TParam PName, Kind))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TParam PName -> ParseM (PName, (TParam PName, Kind))
    forall {n}. TParam n -> ParseM (n, (TParam n, Kind))
    tpK [TParam PName]
    as
             Bool -> ParseM () -> ParseM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([PName] -> Bool
    forall {a}. Eq a => [a] -> Bool
    distinct (((PName, (TParam PName, Kind)) -> PName)
    -> [(PName, (TParam PName, Kind))] -> [PName]
    forall a b. (a -> b) -> [a] -> [b]
    map (PName, (TParam PName, Kind)) -> PName
    forall a b. (a, b) -> a
    fst [(PName, (TParam PName, Kind))]
    vs)) (ParseM () -> ParseM ()) -> ParseM () -> ParseM ()
    forall a b. (a -> b) -> a -> b
    $
                Range -> [[Char]] -> ParseM ()
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    schema_rng [[Char]
    "Repeated parameters."]
             let kindMap :: Map PName (TParam PName, Kind)
    kindMap = [(PName, (TParam PName, Kind))] -> Map PName (TParam PName, Kind)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(PName, (TParam PName, Kind))]
    vs
                 lkp :: LPName -> ParseM (TParam PName, Kind)
    lkp LPName
    v = case PName
    -> Map PName (TParam PName, Kind) -> Maybe (TParam PName, Kind)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup (LPName -> PName
    forall a. Located a -> a
    thing LPName
    v) Map PName (TParam PName, Kind)
    kindMap of
                           Just (TParam PName
    k,Kind
    tp)  -> (TParam PName, Kind) -> ParseM (TParam PName, Kind)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TParam PName
    k,Kind
    tp)
                           Maybe (TParam PName, Kind)
    Nothing ->
                            Range -> [[Char]] -> ParseM (TParam PName, Kind)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage
                                (LPName -> Range
    forall a. Located a -> Range
    srcRange LPName
    v)
                                [[Char]
    "Undefined parameter: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Doc -> [Char]
    forall a. Show a => a -> [Char]
    show (PName -> Doc
    forall a. PP a => a -> Doc
    pp (LPName -> PName
    forall a. Located a -> a
    thing LPName
    v))]
             ([TParam PName]
    as',[Kind]
    ins) <- [(TParam PName, Kind)] -> ([TParam PName], [Kind])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(TParam PName, Kind)] -> ([TParam PName], [Kind]))
    -> ParseM [(TParam PName, Kind)] -> ParseM ([TParam PName], [Kind])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (LPName -> ParseM (TParam PName, Kind))
    -> [LPName] -> ParseM [(TParam PName, Kind)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM LPName -> ParseM (TParam PName, Kind)
    lkp [LPName]
    xs
             Bool -> ParseM () -> ParseM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(PName, (TParam PName, Kind))] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(PName, (TParam PName, Kind))]
    vs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [LPName] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [LPName]
    xs) (ParseM () -> ParseM ()) -> ParseM () -> ParseM ()
    forall a b. (a -> b) -> a -> b
    $
               Range -> [[Char]] -> ParseM ()
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    schema_rng [[Char]
    "All parameters should appear in the type."]

             let ki :: Located Kind
    ki = Located Kind
    finK { thing :: Kind
    thing = (Kind -> Kind -> Kind) -> Kind -> [Kind] -> Kind
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Kind -> Kind -> Kind
    KFun (Located Kind -> Kind
    forall a. Located a -> a
    thing Located Kind
    finK) [Kind]
    ins }

             [TopDecl PName] -> ParseM [TopDecl PName]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ TopLevel (PrimType PName) -> TopDecl PName
    forall name. TopLevel (PrimType name) -> TopDecl name
    DPrimType TopLevel
                      { tlExport :: ExportType
    tlExport = ExportType
    Public
                      , tlDoc :: Maybe (Located Text)
    tlDoc    = Maybe (Located Text)
    mbDoc
                      , tlValue :: PrimType PName
    tlValue  = PrimType { primTName :: LPName
    primTName   = LPName
    n
                                            , primTKind :: Located Kind
    primTKind   = Located Kind
    ki
                                            , primTCts :: ([TParam PName], [Prop PName])
    primTCts    = ([TParam PName]
    as',[Prop PName]
    qs)
                                            , primTFixity :: Maybe Fixity
    primTFixity = Maybe Fixity
    forall a. Maybe a
    Nothing
                                            }
                     }
                  ]

        Maybe (LPName, [LPName])
    Nothing -> Range -> [[Char]] -> ParseM [TopDecl PName]
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    schema_rng [[Char]
    "Invalid primitive signature"]

      where
      splitT :: Range -> Type a -> Maybe (Located a, [Located a])
    splitT Range
    r Type a
    ty = case Type a
    ty of
                      TLocated Type a
    t Range
    r1 -> Range -> Type a -> Maybe (Located a, [Located a])
    splitT Range
    r1 Type a
    t
                      TUser a
    n [Type a]
    ts -> Range -> Located a -> [Type a] -> Maybe (Located a, [Located a])
    forall {a} {a}.
    Eq a =>
    Range -> a -> [Type a] -> Maybe (a, [Located a])
    mkT Range
    r Located { srcRange :: Range
    srcRange = Range
    r, thing :: a
    thing = a
    n } [Type a]
    ts
                      TInfix Type a
    t1 Located a
    n Fixity
    _ Type a
    t2  -> Range -> Located a -> [Type a] -> Maybe (Located a, [Located a])
    forall {a} {a}.
    Eq a =>
    Range -> a -> [Type a] -> Maybe (a, [Located a])
    mkT Range
    r Located a
    n [Type a
    t1,Type a
    t2]
                      Type a
    _ -> Maybe (Located a, [Located a])
    forall a. Maybe a
    Nothing

      mkT :: Range -> a -> [Type a] -> Maybe (a, [Located a])
    mkT Range
    r a
    n [Type a]
    ts = do [Located a]
    ts1 <- (Type a -> Maybe (Located a)) -> [Type a] -> Maybe [Located a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Range -> Type a -> Maybe (Located a)
    forall {a}. Range -> Type a -> Maybe (Located a)
    isVar Range
    r) [Type a]
    ts
                      Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard ([a] -> Bool
    forall {a}. Eq a => [a] -> Bool
    distinct ((Located a -> a) -> [Located a] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map Located a -> a
    forall a. Located a -> a
    thing [Located a]
    ts1))
                      (a, [Located a]) -> Maybe (a, [Located a])
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    n,[Located a]
    ts1)

      isVar :: Range -> Type a -> Maybe (Located a)
    isVar Range
    r Type a
    ty = case Type a
    ty of
                     TLocated Type a
    t Range
    r1  -> Range -> Type a -> Maybe (Located a)
    isVar Range
    r1 Type a
    t
                     TUser a
    n []     -> Located a -> Maybe (Located a)
    forall a. a -> Maybe a
    Just Located { srcRange :: Range
    srcRange = Range
    r, thing :: a
    thing = a
    n }
                     Type a
    _              -> Maybe (Located a)
    forall a. Maybe a
    Nothing

      -- inefficient, but the lists should be small
      distinct :: [a] -> Bool
    distinct [a]
    xs = case [a]
    xs of
                      [] -> Bool
    True
                      a
    x : [a]
    ys -> Bool -> Bool
    not (a
    x a -> [a] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [a]
    ys) Bool -> Bool -> Bool
    && [a] -> Bool
    distinct [a]
    ys

      tpK :: TParam n -> ParseM (n, (TParam n, Kind))
    tpK TParam n
    tp = case TParam n -> Maybe Kind
    forall n. TParam n -> Maybe Kind
    tpKind TParam n
    tp of
                 Just Kind
    k  -> (n, (TParam n, Kind)) -> ParseM (n, (TParam n, Kind))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TParam n -> n
    forall n. TParam n -> n
    tpName TParam n
    tp, (TParam n
    tp,Kind
    k))
                 Maybe Kind
    Nothing ->
                  case TParam n -> Maybe Range
    forall n. TParam n -> Maybe Range
    tpRange TParam n
    tp of
                    Just Range
    r -> Range -> [[Char]] -> ParseM (n, (TParam n, Kind))
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    r [[Char]
    "Parameters need a kind annotation"]
                    Maybe Range
    Nothing -> [Char] -> [[Char]] -> ParseM (n, (TParam n, Kind))
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "mkPrimTypeDecl"
                                  [ [Char]
    "Missing range on schema parameter." ]

    -- | Fix-up the documentation strings by removing the comment delimiters on each
    -- end, and stripping out common prefixes on all the remaining lines.
    mkDoc :: Located Text -> Located Text
    mkDoc :: Located Text -> Located Text
    mkDoc Located Text
    ltxt = Located Text
    ltxt { thing :: Text
    thing = Text
    docStr }
      where

      docStr :: Text
    docStr = [Text] -> Text
    T.unlines
             ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text]
    dropPrefix
             ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text]
    trimFront
             ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Text -> [Text]
    T.lines
             (Text -> [Text]) -> Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> Text -> Text
    T.dropWhileEnd Char -> Bool
    commentChar
             (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Located Text -> Text
    forall a. Located a -> a
    thing Located Text
    ltxt

      commentChar :: Char -> Bool
      commentChar :: Char -> Bool
    commentChar Char
    x = Char
    x Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char]
    "/* \r\n\t" :: String)

      prefixDroppable :: Char -> Bool
    prefixDroppable Char
    x = Char
    x Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char]
    "* \r\n\t" :: String)

      whitespaceChar :: Char -> Bool
      whitespaceChar :: Char -> Bool
    whitespaceChar Char
    x = Char
    x Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ([Char]
    " \r\n\t" :: String)

      trimFront :: [Text] -> [Text]
    trimFront []                     = []
      trimFront (Text
    l:[Text]
    ls)
        | (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    commentChar Text
    l = [Text]
    ls
        | Bool
    otherwise           = (Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    commentChar Text
    l Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    ls

      dropPrefix :: [Text] -> [Text]
    dropPrefix []        = []
      dropPrefix [Text
    t]       = [(Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    commentChar Text
    t]
      dropPrefix ts :: [Text]
    ts@(Text
    l:[Text]
    ls) =
        case Text -> Maybe (Char, Text)
    T.uncons Text
    l of
          Just (Char
    c,Text
    _) | Char -> Bool
    prefixDroppable Char
    c Bool -> Bool -> Bool
    &&
                       (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Char -> Text -> Bool
    commonPrefix Char
    c) [Text]
    ls -> [Text] -> [Text]
    dropPrefix ((Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Text -> Text
    T.drop Int
    1) [Text]
    ts)
          Maybe (Char, Text)
    _                                    -> [Text]
    ts

        where
        commonPrefix :: Char -> Text -> Bool
    commonPrefix Char
    c Text
    t =
          case Text -> Maybe (Char, Text)
    T.uncons Text
    t of
            Just (Char
    c',Text
    _) -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c'
            Maybe (Char, Text)
    Nothing     -> Char -> Bool
    whitespaceChar Char
    c -- end-of-line matches any whitespace

    distrLoc :: Located [a] -> [Located a]
    distrLoc :: forall a. Located [a] -> [Located a]
    distrLoc Located [a]
    x = [ Located { srcRange :: Range
    srcRange = Range
    r, thing :: a
    thing = a
    a } | a
    a <- Located [a] -> [a]
    forall a. Located a -> a
    thing Located [a]
    x ]
      where r :: Range
    r = Located [a] -> Range
    forall a. Located a -> Range
    srcRange Located [a]
    x

    mkPropGuards :: Type PName -> ParseM [Located (Prop PName)]
    mkPropGuards :: Type PName -> ParseM [Located (Prop PName)]
    mkPropGuards Type PName
    ty =
      do Located [Prop PName]
    lp <- Type PName -> ParseM (Located [Prop PName])
    mkProp Type PName
    ty
         [Located (Prop PName)] -> ParseM [Located (Prop PName)]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ Located [Prop PName]
    lp { thing :: Prop PName
    thing = Prop PName
    p } | Prop PName
    p <- Located [Prop PName] -> [Prop PName]
    forall a. Located a -> a
    thing Located [Prop PName]
    lp ]

    mkProp :: Type PName -> ParseM (Located [Prop PName])
    mkProp :: Type PName -> ParseM (Located [Prop PName])
    mkProp Type PName
    ty =
      case Type PName
    ty of
        TLocated Type PName
    t Range
    r -> Range -> [Prop PName] -> Located [Prop PName]
    forall a. Range -> a -> Located a
    Located Range
    r ([Prop PName] -> Located [Prop PName])
    -> ParseM [Prop PName] -> ParseM (Located [Prop PName])
    forall a b. (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Range -> Type PName -> ParseM [Prop PName]
    forall {n}. Range -> Type n -> ParseM [Prop n]
    props Range
    r Type PName
    t
        Type PName
    _            -> [Char] -> [[Char]] -> ParseM (Located [Prop PName])
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "Parser" [ [Char]
    "Invalid type given to mkProp"
                                       , [Char]
    "expected a location"
                                       , Type PName -> [Char]
    forall a. Show a => a -> [Char]
    show Type PName
    ty ]

      where

      props :: Range -> Type n -> ParseM [Prop n]
    props Range
    r Type n
    t =
        case Type n
    t of
          TInfix{}       -> [Prop n] -> ParseM [Prop n]
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Type n -> Prop n
    forall n. Type n -> Prop n
    CType Type n
    t]
          TUser{}        -> [Prop n] -> ParseM [Prop n]
    forall a. a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Type n -> Prop n
    forall n. Type n -> Prop n
    CType Type n
    t]
          TTuple [Type n]
    ts      -> [[Prop n]] -> [Prop n]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Prop n]] -> [Prop n]) -> ParseM [[Prop n]] -> ParseM [Prop n]
    forall a b. (a -> b) -> ParseM a -> ParseM b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (Type n -> ParseM [Prop n]) -> [Type n] -> ParseM [[Prop n]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Range -> Type n -> ParseM [Prop n]
    props Range
    r) [Type n]
    ts
          TParens Type n
    t' Maybe Kind
    mb  -> case Maybe Kind
    mb of
                              Maybe Kind
    Nothing -> Range -> Type n -> ParseM [Prop n]
    props Range
    r Type n
    t'
                              Just Kind
    _  -> ParseM [Prop n]
    forall a. ParseM a
    err

          TLocated Type n
    t' Range
    r' -> Range -> Type n -> ParseM [Prop n]
    props Range
    r' Type n
    t'

          TFun{}    -> ParseM [Prop n]
    forall a. ParseM a
    err
          TSeq{}    -> ParseM [Prop n]
    forall a. ParseM a
    err
          TBit{}    -> ParseM [Prop n]
    forall a. ParseM a
    err
          TNum{}    -> ParseM [Prop n]
    forall a. ParseM a
    err
          TChar{}   -> ParseM [Prop n]
    forall a. ParseM a
    err
          Type n
    TWild     -> ParseM [Prop n]
    forall a. ParseM a
    err
          TRecord{} -> ParseM [Prop n]
    forall a. ParseM a
    err
          TTyApp{}  -> ParseM [Prop n]
    forall a. ParseM a
    err

        where
        err :: ParseM a
    err = Range -> [[Char]] -> ParseM a
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    r [[Char]
    "Invalid constraint"]

    -- | Make an ordinary module
    mkModule :: Located ModName -> [TopDecl PName] -> Module PName
    mkModule :: Located ModName -> [TopDecl PName] -> Module PName
    mkModule Located ModName
    nm [TopDecl PName]
    ds = Module { mName :: Located ModName
    mName = Located ModName
    nm
                            , mDef :: ModuleDefinition PName
    mDef = [TopDecl PName] -> ModuleDefinition PName
    forall name. [TopDecl name] -> ModuleDefinition name
    NormalModule [TopDecl PName]
    ds
                            }

    mkNested :: Module PName -> ParseM (NestedModule PName)
    mkNested :: Module PName -> ParseM (NestedModule PName)
    mkNested Module PName
    m =
      case ModName -> [[Char]]
    modNameChunks (Located ModName -> ModName
    forall a. Located a -> a
    thing Located ModName
    nm) of
        [[Char]
    c] -> NestedModule PName -> ParseM (NestedModule PName)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ModuleG PName PName -> NestedModule PName
    forall name. ModuleG name name -> NestedModule name
    NestedModule Module PName
    m { mName :: LPName
    mName = Located ModName
    nm { thing :: PName
    thing = Ident -> PName
    mkUnqual ([Char] -> Ident
    packIdent [Char]
    c)}})
        [[Char]]
    _   -> Range -> [[Char]] -> ParseM (NestedModule PName)
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    r
                    [[Char]
    "Nested modules names should be a simple identifier."]
      where
      nm :: Located ModName
    nm = Module PName -> Located ModName
    forall mname name. ModuleG mname name -> Located mname
    mName Module PName
    m
      r :: Range
    r = Located ModName -> Range
    forall a. Located a -> Range
    srcRange Located ModName
    nm

    mkSigDecl :: Maybe (Located Text) -> (Located PName,Signature PName) -> TopDecl PName
    mkSigDecl :: Maybe (Located Text) -> (LPName, Signature PName) -> TopDecl PName
    mkSigDecl Maybe (Located Text)
    doc (LPName
    nm,Signature PName
    sig) =
      TopLevel (NestedModule PName) -> TopDecl PName
    forall name. TopLevel (NestedModule name) -> TopDecl name
    DModule
      TopLevel { tlExport :: ExportType
    tlExport = ExportType
    Public
               , tlDoc :: Maybe (Located Text)
    tlDoc    = Maybe (Located Text)
    doc
               , tlValue :: NestedModule PName
    tlValue  = ModuleG PName PName -> NestedModule PName
    forall name. ModuleG name name -> NestedModule name
    NestedModule
                            Module { mName :: LPName
    mName = LPName
    nm
                                   , mDef :: ModuleDefinition PName
    mDef  = Signature PName -> ModuleDefinition PName
    forall name. Signature name -> ModuleDefinition name
    InterfaceModule Signature PName
    sig
                                   }
               }

    mkInterfaceConstraint ::
      Maybe (Located Text) -> Type PName -> ParseM [TopDecl PName]
    mkInterfaceConstraint :: Maybe (Located Text) -> Type PName -> ParseM [TopDecl PName]
    mkInterfaceConstraint Maybe (Located Text)
    mbDoc Type PName
    ty =
      do Located [Prop PName]
    ps <- Type PName -> ParseM (Located [Prop PName])
    mkProp Type PName
    ty
         [TopDecl PName] -> ParseM [TopDecl PName]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Maybe Text -> Located [Prop PName] -> TopDecl PName
    forall name. Maybe Text -> Located [Prop name] -> TopDecl name
    DInterfaceConstraint (Located Text -> Text
    forall a. Located a -> a
    thing (Located Text -> Text) -> Maybe (Located Text) -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Located Text)
    mbDoc) Located [Prop PName]
    ps]

    mkParDecls :: [ParamDecl PName] -> TopDecl PName
    mkParDecls :: [ParamDecl PName] -> TopDecl PName
    mkParDecls [ParamDecl PName]
    ds = Range -> Signature PName -> TopDecl PName
    forall name. Range -> Signature name -> TopDecl name
    DParamDecl Range
    loc ([Located (ImportG (ImpName PName))]
    -> [ParamDecl PName] -> Signature PName
    mkInterface' [] [ParamDecl PName]
    ds)
      where loc :: Range
    loc = [Range] -> Range
    rCombs ((ParamDecl PName -> Maybe Range) -> [ParamDecl PName] -> [Range]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ParamDecl PName -> Maybe Range
    forall t. HasLoc t => t -> Maybe Range
    getLoc [ParamDecl PName]
    ds)

    onlySimpleImports :: [Located (ImportG (ImpName PName))] -> ParseM ()
    onlySimpleImports :: [Located (ImportG (ImpName PName))] -> ParseM ()
    onlySimpleImports = (Located (ImportG (ImpName PName)) -> ParseM ())
    -> [Located (ImportG (ImpName PName))] -> ParseM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Located (ImportG (ImpName PName)) -> ParseM ()
    forall {mname}. Located (ImportG mname) -> ParseM ()
    check
      where
      check :: Located (ImportG mname) -> ParseM ()
    check Located (ImportG mname)
    i =
        case ImportG mname -> Maybe (ModuleInstanceArgs PName)
    forall mname. ImportG mname -> Maybe (ModuleInstanceArgs PName)
    iInst (Located (ImportG mname) -> ImportG mname
    forall a. Located a -> a
    thing Located (ImportG mname)
    i) of
          Maybe (ModuleInstanceArgs PName)
    Nothing -> () -> ParseM ()
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
          Just ModuleInstanceArgs PName
    _  ->
            Range -> [[Char]] -> ParseM ()
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage (Located (ImportG mname) -> Range
    forall a. Located a -> Range
    srcRange Located (ImportG mname)
    i)
              [ [Char]
    "Functor instantiations are not supported in this context."
              , [Char]
    "The imported entity needs to be just the name of a module."
              , [Char]
    "A workaround would be to do the instantion in the outer context."
              ]

    mkInterface' :: [Located (ImportG (ImpName PName))] ->
                 [ParamDecl PName] -> Signature PName
    mkInterface' :: [Located (ImportG (ImpName PName))]
    -> [ParamDecl PName] -> Signature PName
    mkInterface' [Located (ImportG (ImpName PName))]
    is =
      (Signature PName -> ParamDecl PName -> Signature PName)
    -> Signature PName -> [ParamDecl PName] -> Signature PName
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Signature PName -> ParamDecl PName -> Signature PName
    forall {name}. Signature name -> ParamDecl name -> Signature name
    add
        Signature { sigImports :: [Located (ImportG (ImpName PName))]
    sigImports     = [Located (ImportG (ImpName PName))]
    is
                  , sigTypeParams :: [ParameterType PName]
    sigTypeParams  = []
                  , sigDecls :: [SigDecl PName]
    sigDecls       = []
                  , sigConstraints :: [Located (Prop PName)]
    sigConstraints = []
                  , sigFunParams :: [ParameterFun PName]
    sigFunParams   = []
                  }
      where
      add :: Signature name -> ParamDecl name -> Signature name
    add Signature name
    s ParamDecl name
    d =
        case ParamDecl name
    d of
          DParameterType ParameterType name
    pt       -> Signature name
    s { sigTypeParams :: [ParameterType name]
    sigTypeParams  = ParameterType name
    pt  ParameterType name -> [ParameterType name] -> [ParameterType name]
    forall a. a -> [a] -> [a]
    : Signature name -> [ParameterType name]
    forall name. Signature name -> [ParameterType name]
    sigTypeParams Signature name
    s  }
          DParameterConstraint [Located (Prop name)]
    ps -> Signature name
    s { sigConstraints :: [Located (Prop name)]
    sigConstraints = [Located (Prop name)]
    ps [Located (Prop name)]
    -> [Located (Prop name)] -> [Located (Prop name)]
    forall a. [a] -> [a] -> [a]
    ++ Signature name -> [Located (Prop name)]
    forall name. Signature name -> [Located (Prop name)]
    sigConstraints Signature name
    s }
          DParameterDecl SigDecl name
    pd       -> Signature name
    s { sigDecls :: [SigDecl name]
    sigDecls       = SigDecl name
    pd  SigDecl name -> [SigDecl name] -> [SigDecl name]
    forall a. a -> [a] -> [a]
    : Signature name -> [SigDecl name]
    forall name. Signature name -> [SigDecl name]
    sigDecls Signature name
    s       }
          DParameterFun ParameterFun name
    pf        -> Signature name
    s { sigFunParams :: [ParameterFun name]
    sigFunParams   = ParameterFun name
    pf  ParameterFun name -> [ParameterFun name] -> [ParameterFun name]
    forall a. a -> [a] -> [a]
    : Signature name -> [ParameterFun name]
    forall name. Signature name -> [ParameterFun name]
    sigFunParams Signature name
    s   }

    mkInterface :: [Located (ImportG (ImpName PName))] ->
                 [ParamDecl PName] -> ParseM (Signature PName)
    mkInterface :: [Located (ImportG (ImpName PName))]
    -> [ParamDecl PName] -> ParseM (Signature PName)
    mkInterface [Located (ImportG (ImpName PName))]
    is [ParamDecl PName]
    ps =
      do [Located (ImportG (ImpName PName))] -> ParseM ()
    onlySimpleImports [Located (ImportG (ImpName PName))]
    is
         Signature PName -> ParseM (Signature PName)
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Located (ImportG (ImpName PName))]
    -> [ParamDecl PName] -> Signature PName
    mkInterface' [Located (ImportG (ImpName PName))]
    is [ParamDecl PName]
    ps)

    mkIfacePropSyn :: Maybe Text -> Decl PName -> ParamDecl PName
    mkIfacePropSyn :: Maybe Text -> Decl PName -> ParamDecl PName
    mkIfacePropSyn Maybe Text
    mbDoc Decl PName
    d =
      case Decl PName
    d of
        DLocated Decl PName
    d1 Range
    _ -> Maybe Text -> Decl PName -> ParamDecl PName
    mkIfacePropSyn Maybe Text
    mbDoc Decl PName
    d1
        DType TySyn PName
    ts    -> SigDecl PName -> ParamDecl PName
    forall name. SigDecl name -> ParamDecl name
    DParameterDecl (TySyn PName -> Maybe Text -> SigDecl PName
    forall name. TySyn name -> Maybe Text -> SigDecl name
    SigTySyn TySyn PName
    ts Maybe Text
    mbDoc)
        DProp PropSyn PName
    ps    -> SigDecl PName -> ParamDecl PName
    forall name. SigDecl name -> ParamDecl name
    DParameterDecl (PropSyn PName -> Maybe Text -> SigDecl PName
    forall name. PropSyn name -> Maybe Text -> SigDecl name
    SigPropSyn PropSyn PName
    ps Maybe Text
    mbDoc)
        Decl PName
    _ -> [Char] -> [[Char]] -> ParamDecl PName
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "mkIfacePropSyn" [ [Char]
    "Unexpected declaration", Doc -> [Char]
    forall a. Show a => a -> [Char]
    show (Decl PName -> Doc
    forall a. PP a => a -> Doc
    pp Decl PName
    d) ]

    -- | Make an unnamed module---gets the name @Main@.
    mkAnonymousModule :: [TopDecl PName] -> ParseM [Module PName]
    mkAnonymousModule :: [TopDecl PName] -> ParseM [Module PName]
    mkAnonymousModule = Module PName -> ParseM [Module PName]
    mkTopMods
                      (Module PName -> ParseM [Module PName])
    -> ([TopDecl PName] -> Module PName)
    -> [TopDecl PName]
    -> ParseM [Module PName]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located ModName -> [TopDecl PName] -> Module PName
    mkModule Located { srcRange :: Range
    srcRange = Range
    emptyRange
                                         , thing :: ModName
    thing    = [Text] -> ModName
    mkModName [[Char] -> Text
    T.pack [Char]
    "Main"]
                                         }

    -- | Make a module which defines a functor instance.
    mkModuleInstanceAnon :: Located ModName ->
                          Located (ImpName PName) ->
                          [TopDecl PName] ->
                          Module PName
    mkModuleInstanceAnon :: Located ModName
    -> Located (ImpName PName) -> [TopDecl PName] -> Module PName
    mkModuleInstanceAnon Located ModName
    nm Located (ImpName PName)
    fun [TopDecl PName]
    ds =
      Module { mName :: Located ModName
    mName  = Located ModName
    nm
             , mDef :: ModuleDefinition PName
    mDef   = Located (ImpName PName)
    -> ModuleInstanceArgs PName
    -> ModuleInstance PName
    -> ModuleDefinition PName
    forall name.
    Located (ImpName name)
    -> ModuleInstanceArgs name
    -> ModuleInstance name
    -> ModuleDefinition name
    FunctorInstance Located (ImpName PName)
    fun ([TopDecl PName] -> ModuleInstanceArgs PName
    forall name. [TopDecl name] -> ModuleInstanceArgs name
    DefaultInstAnonArg [TopDecl PName]
    ds) ModuleInstance PName
    forall a. Monoid a => a
    mempty
             }

    mkModuleInstance ::
      Located ModName ->
      Located (ImpName PName) ->
      ModuleInstanceArgs PName ->
      Module PName
    mkModuleInstance :: Located ModName
    -> Located (ImpName PName)
    -> ModuleInstanceArgs PName
    -> Module PName
    mkModuleInstance Located ModName
    m Located (ImpName PName)
    f ModuleInstanceArgs PName
    as =
      Module { mName :: Located ModName
    mName = Located ModName
    m
             , mDef :: ModuleDefinition PName
    mDef  = Located (ImpName PName)
    -> ModuleInstanceArgs PName
    -> ModuleInstance PName
    -> ModuleDefinition PName
    forall name.
    Located (ImpName name)
    -> ModuleInstanceArgs name
    -> ModuleInstance name
    -> ModuleDefinition name
    FunctorInstance Located (ImpName PName)
    f ModuleInstanceArgs PName
    as ModuleInstance PName
    forall name. Ord name => ModuleInstance name
    emptyModuleInstance
             }

    ufToNamed :: UpdField PName -> ParseM (Named (Expr PName))
    ufToNamed :: UpdField PName -> ParseM (Named (Expr PName))
    ufToNamed (UpdField UpdHow
    h [Located Selector]
    ls Expr PName
    e) =
      case (UpdHow
    h,[Located Selector]
    ls) of
        (UpdHow
    UpdSet, [Located Selector
    l]) | RecordSel Ident
    i Maybe [Ident]
    Nothing <- Located Selector -> Selector
    forall a. Located a -> a
    thing Located Selector
    l ->
          Named (Expr PName) -> ParseM (Named (Expr PName))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Named { name :: Located Ident
    name = Located Selector
    l { thing :: Ident
    thing = Ident
    i }, value :: Expr PName
    value = Expr PName
    e }
        (UpdHow, [Located Selector])
    _ -> Range -> [[Char]] -> ParseM (Named (Expr PName))
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage (Located Selector -> Range
    forall a. Located a -> Range
    srcRange ([Located Selector] -> Located Selector
    forall a. HasCallStack => [a] -> a
    head [Located Selector]
    ls))
                [[Char]
    "Invalid record field.  Perhaps you meant to update a record?"]

    exprToFieldPath :: Expr PName -> ParseM [Located Selector]
    exprToFieldPath :: Expr PName -> ParseM [Located Selector]
    exprToFieldPath Expr PName
    e0 = [Located Selector] -> [Located Selector]
    forall a. [a] -> [a]
    reverse ([Located Selector] -> [Located Selector])
    -> ParseM [Located Selector] -> ParseM [Located Selector]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Range -> Expr PName -> ParseM [Located Selector]
    go Range
    forall {a}. a
    noLoc Expr PName
    e0
      where
      noLoc :: a
    noLoc = [Char] -> [[Char]] -> a
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "selExprToSels" [[Char]
    "Missing location?"]
      go :: Range -> Expr PName -> ParseM [Located Selector]
    go Range
    loc Expr PName
    expr =
        case Expr PName
    expr of
          ELocated Expr PName
    e1 Range
    r -> Range -> Expr PName -> ParseM [Located Selector]
    go Range
    r Expr PName
    e1
          ESel Expr PName
    e2 Selector
    s ->
            do [Located Selector]
    ls <- Range -> Expr PName -> ParseM [Located Selector]
    go Range
    loc Expr PName
    e2
               let rng :: Range
    rng = Range
    loc { from :: Position
    from = Range -> Position
    to (Located Selector -> Range
    forall a. Located a -> Range
    srcRange ([Located Selector] -> Located Selector
    forall a. HasCallStack => [a] -> a
    head [Located Selector]
    ls)) }
               [Located Selector] -> ParseM [Located Selector]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Located { thing :: Selector
    thing = Selector
    s, srcRange :: Range
    srcRange = Range
    rng } Located Selector -> [Located Selector] -> [Located Selector]
    forall a. a -> [a] -> [a]
    : [Located Selector]
    ls)
          EVar (UnQual Ident
    l) ->
            [Located Selector] -> ParseM [Located Selector]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ Located { thing :: Selector
    thing = Ident -> Maybe [Ident] -> Selector
    RecordSel Ident
    l Maybe [Ident]
    forall a. Maybe a
    Nothing, srcRange :: Range
    srcRange = Range
    loc } ]

          ELit (ECNum Integer
    n (DecLit {})) ->
            [Located Selector] -> ParseM [Located Selector]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ Located { thing :: Selector
    thing = Int -> Maybe Int -> Selector
    TupleSel (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    n) Maybe Int
    forall a. Maybe a
    Nothing
                           , srcRange :: Range
    srcRange = Range
    loc } ]

          ELit (ECFrac Rational
    _ (DecFrac Text
    txt))
            | (Text
    as,Text
    bs') <- (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') Text
    txt
            , Just Int
    a <- [Char] -> Maybe Int
    forall a. Read a => [Char] -> Maybe a
    readMaybe (Text -> [Char]
    T.unpack Text
    as)
            , Just (Char
    _,Text
    bs) <- Text -> Maybe (Char, Text)
    T.uncons Text
    bs'
            , Just Int
    b <- [Char] -> Maybe Int
    forall a. Read a => [Char] -> Maybe a
    readMaybe (Text -> [Char]
    T.unpack Text
    bs)
            , let fromP :: Position
    fromP = Range -> Position
    from Range
    loc
            , let midP :: Position
    midP  = Position
    fromP { col :: Int
    col = Position -> Int
    col Position
    fromP Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Text -> Int
    T.length Text
    as Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 } ->
              -- these are backward because we reverse above
              [Located Selector] -> ParseM [Located Selector]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ Located { thing :: Selector
    thing    = Int -> Maybe Int -> Selector
    TupleSel Int
    b Maybe Int
    forall a. Maybe a
    Nothing
                             , srcRange :: Range
    srcRange = Range
    loc { from :: Position
    from = Position
    midP }
                             }
                   , Located { thing :: Selector
    thing    = Int -> Maybe Int -> Selector
    TupleSel Int
    a Maybe Int
    forall a. Maybe a
    Nothing
                             , srcRange :: Range
    srcRange = Range
    loc { to :: Position
    to = Position
    midP }
                             }
                   ]

          Expr PName
    _ -> Range -> [[Char]] -> ParseM [Located Selector]
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    loc [[Char]
    "Invalid label in record update."]

    mkSelector :: Token -> Selector
    mkSelector :: Token -> Selector
    mkSelector Token
    tok =
      case Token -> TokenT
    tokenType Token
    tok of
        Selector (TupleSelectorTok Int
    n) -> Int -> Maybe Int -> Selector
    TupleSel Int
    n Maybe Int
    forall a. Maybe a
    Nothing
        Selector (RecordSelectorTok Text
    t) -> Ident -> Maybe [Ident] -> Selector
    RecordSel (Text -> Ident
    mkIdent Text
    t) Maybe [Ident]
    forall a. Maybe a
    Nothing
        TokenT
    _ -> [Char] -> [[Char]] -> Selector
    forall a. HasCallStack => [Char] -> [[Char]] -> a
    panic [Char]
    "mkSelector" [ [Char]
    "Unexpected selector token", Token -> [Char]
    forall a. Show a => a -> [Char]
    show Token
    tok ]

    mkBacktickImport ::
      Range ->
      Located (ImpName PName) ->
      Maybe (Located ModName) ->
      Maybe (Located ImportSpec) ->
      ParseM (Located (ImportG (ImpName PName)))
    mkBacktickImport :: Range
    -> Located (ImpName PName)
    -> Maybe (Located ModName)
    -> Maybe (Located ImportSpec)
    -> ParseM (Located (ImportG (ImpName PName)))
    mkBacktickImport Range
    loc Located (ImpName PName)
    impName Maybe (Located ModName)
    mbAs Maybe (Located ImportSpec)
    mbImportSpec =
      Range
    -> Located (ImpName PName)
    -> Maybe (ModuleInstanceArgs PName)
    -> Maybe (Located ModName)
    -> Maybe (Located ImportSpec)
    -> Maybe (Located [Decl PName])
    -> ParseM (Located (ImportG (ImpName PName)))
    mkImport Range
    loc Located (ImpName PName)
    impName (ModuleInstanceArgs PName -> Maybe (ModuleInstanceArgs PName)
    forall a. a -> Maybe a
    Just ModuleInstanceArgs PName
    forall {name}. ModuleInstanceArgs name
    inst) Maybe (Located ModName)
    mbAs Maybe (Located ImportSpec)
    mbImportSpec Maybe (Located [Decl PName])
    forall a. Maybe a
    Nothing
      where
      inst :: ModuleInstanceArgs name
    inst = Located (ModuleInstanceArg name) -> ModuleInstanceArgs name
    forall name.
    Located (ModuleInstanceArg name) -> ModuleInstanceArgs name
    DefaultInstArg ((ImpName PName -> ModuleInstanceArg name)
    -> Located (ImpName PName) -> Located (ModuleInstanceArg name)
    forall a b. (a -> b) -> Located a -> Located b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ModuleInstanceArg name -> ImpName PName -> ModuleInstanceArg name
    forall a b. a -> b -> a
    const ModuleInstanceArg name
    forall name. ModuleInstanceArg name
    AddParams) Located (ImpName PName)
    impName)

    mkImport ::
      Range ->
      Located (ImpName PName) ->
      Maybe (ModuleInstanceArgs PName) ->
      Maybe (Located ModName) ->
      Maybe (Located ImportSpec) ->
      Maybe (Located [Decl PName]) ->
      ParseM (Located (ImportG (ImpName PName)))

    mkImport :: Range
    -> Located (ImpName PName)
    -> Maybe (ModuleInstanceArgs PName)
    -> Maybe (Located ModName)
    -> Maybe (Located ImportSpec)
    -> Maybe (Located [Decl PName])
    -> ParseM (Located (ImportG (ImpName PName)))
    mkImport Range
    loc Located (ImpName PName)
    impName Maybe (ModuleInstanceArgs PName)
    optInst Maybe (Located ModName)
    mbAs Maybe (Located ImportSpec)
    mbImportSpec Maybe (Located [Decl PName])
    optImportWhere =
      do Maybe (ModuleInstanceArgs PName)
    i <- ParseM (Maybe (ModuleInstanceArgs PName))
    getInst
         let end :: Range
    end = Range -> Maybe Range -> Range
    forall a. a -> Maybe a -> a
    fromMaybe (Located (ImpName PName) -> Range
    forall a. Located a -> Range
    srcRange Located (ImpName PName)
    impName)
                 (Maybe Range -> Range) -> Maybe Range -> Range
    forall a b. (a -> b) -> a -> b
    $ [Maybe Range] -> Maybe Range
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum [ Located [Decl PName] -> Range
    forall a. Located a -> Range
    srcRange (Located [Decl PName] -> Range)
    -> Maybe (Located [Decl PName]) -> Maybe Range
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Located [Decl PName])
    optImportWhere
                        , Located ImportSpec -> Range
    forall a. Located a -> Range
    srcRange (Located ImportSpec -> Range)
    -> Maybe (Located ImportSpec) -> Maybe Range
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Located ImportSpec)
    mbImportSpec
                        , Located ModName -> Range
    forall a. Located a -> Range
    srcRange (Located ModName -> Range)
    -> Maybe (Located ModName) -> Maybe Range
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Located ModName)
    mbAs
                        ]

         Located (ImportG (ImpName PName))
    -> ParseM (Located (ImportG (ImpName PName)))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Located { srcRange :: Range
    srcRange = Range -> Range -> Range
    rComb Range
    loc Range
    end
                      , thing :: ImportG (ImpName PName)
    thing    = Import
                                     { iModule :: ImpName PName
    iModule    = Located (ImpName PName) -> ImpName PName
    forall a. Located a -> a
    thing Located (ImpName PName)
    impName
                                     , iAs :: Maybe ModName
    iAs        = Located ModName -> ModName
    forall a. Located a -> a
    thing (Located ModName -> ModName)
    -> Maybe (Located ModName) -> Maybe ModName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Located ModName)
    mbAs
                                     , iSpec :: Maybe ImportSpec
    iSpec      = Located ImportSpec -> ImportSpec
    forall a. Located a -> a
    thing (Located ImportSpec -> ImportSpec)
    -> Maybe (Located ImportSpec) -> Maybe ImportSpec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Located ImportSpec)
    mbImportSpec
                                     , iInst :: Maybe (ModuleInstanceArgs PName)
    iInst      = Maybe (ModuleInstanceArgs PName)
    i
                                     }
                      }
      where
      getInst :: ParseM (Maybe (ModuleInstanceArgs PName))
    getInst =
        case (Maybe (ModuleInstanceArgs PName)
    optInst,Maybe (Located [Decl PName])
    optImportWhere) of
          (Just ModuleInstanceArgs PName
    _, Just Located [Decl PName]
    _) ->
             Range -> [[Char]] -> ParseM (Maybe (ModuleInstanceArgs PName))
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    loc [ [Char]
    "Invalid instantiating import."
                              , [Char]
    "Import should have at most one of:"
                              , [Char]
    "  * { } instantiation, or"
                              , [Char]
    "  * where instantiation"
                              ]
          (Just ModuleInstanceArgs PName
    a, Maybe (Located [Decl PName])
    Nothing)  -> Maybe (ModuleInstanceArgs PName)
    -> ParseM (Maybe (ModuleInstanceArgs PName))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ModuleInstanceArgs PName -> Maybe (ModuleInstanceArgs PName)
    forall a. a -> Maybe a
    Just ModuleInstanceArgs PName
    a)
          (Maybe (ModuleInstanceArgs PName)
    Nothing, Just Located [Decl PName]
    a)  ->
            Maybe (ModuleInstanceArgs PName)
    -> ParseM (Maybe (ModuleInstanceArgs PName))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ModuleInstanceArgs PName -> Maybe (ModuleInstanceArgs PName)
    forall a. a -> Maybe a
    Just ([TopDecl PName] -> ModuleInstanceArgs PName
    forall name. [TopDecl name] -> ModuleInstanceArgs name
    DefaultInstAnonArg ((Decl PName -> TopDecl PName) -> [Decl PName] -> [TopDecl PName]
    forall a b. (a -> b) -> [a] -> [b]
    map Decl PName -> TopDecl PName
    forall {name}. Decl name -> TopDecl name
    instTop (Located [Decl PName] -> [Decl PName]
    forall a. Located a -> a
    thing Located [Decl PName]
    a))))
             where
             instTop :: Decl name -> TopDecl name
    instTop Decl name
    d = TopLevel (Decl name) -> TopDecl name
    forall name. TopLevel (Decl name) -> TopDecl name
    Decl TopLevel
                                { tlExport :: ExportType
    tlExport = ExportType
    Public
                                , tlDoc :: Maybe (Located Text)
    tlDoc    = Maybe (Located Text)
    forall a. Maybe a
    Nothing
                                , tlValue :: Decl name
    tlValue  = Decl name
    d
                                }
          (Maybe (ModuleInstanceArgs PName)
    Nothing, Maybe (Located [Decl PName])
    Nothing) -> Maybe (ModuleInstanceArgs PName)
    -> ParseM (Maybe (ModuleInstanceArgs PName))
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (ModuleInstanceArgs PName)
    forall a. Maybe a
    Nothing

    mkTopMods :: Module PName -> ParseM [Module PName]
    mkTopMods :: Module PName -> ParseM [Module PName]
    mkTopMods = Module PName -> ParseM [Module PName]
    forall name.
    MkAnon name =>
    ModuleG name PName -> ParseM [ModuleG name PName]
    desugarMod

    mkTopSig :: Located ModName -> Signature PName -> [Module PName]
    mkTopSig :: Located ModName -> Signature PName -> [Module PName]
    mkTopSig Located ModName
    nm Signature PName
    sig =
      [ Module { mName :: Located ModName
    mName = Located ModName
    nm
               , mDef :: ModuleDefinition PName
    mDef  = Signature PName -> ModuleDefinition PName
    forall name. Signature name -> ModuleDefinition name
    InterfaceModule Signature PName
    sig
               }
      ]

    class MkAnon t where
      mkAnon    :: AnonThing -> t -> t
      toImpName :: t -> ImpName PName

    data AnonThing = AnonArg | AnonIfaceMod

    instance MkAnon ModName where
      mkAnon :: AnonThing -> ModName -> ModName
    mkAnon AnonThing
    what   = case AnonThing
    what of
                        AnonThing
    AnonArg      -> ModName -> ModName
    modNameArg
                        AnonThing
    AnonIfaceMod -> ModName -> ModName
    modNameIfaceMod
      toImpName :: ModName -> ImpName PName
    toImpName     = ModName -> ImpName PName
    forall name. ModName -> ImpName name
    ImpTop

    instance MkAnon PName where
      mkAnon :: AnonThing -> PName -> PName
    mkAnon AnonThing
    what   = Ident -> PName
    mkUnqual
                    (Ident -> PName) -> (PName -> Ident) -> PName -> PName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . case AnonThing
    what of
                        AnonThing
    AnonArg      -> Ident -> Ident
    identAnonArg
                        AnonThing
    AnonIfaceMod -> Ident -> Ident
    identAnonIfaceMod
                    (Ident -> Ident) -> (PName -> Ident) -> PName -> Ident
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PName -> Ident
    getIdent
      toImpName :: PName -> ImpName PName
    toImpName     = PName -> ImpName PName
    forall name. name -> ImpName name
    ImpNested

    desugarMod :: MkAnon name => ModuleG name PName -> ParseM [ModuleG name PName]
    desugarMod :: forall name.
    MkAnon name =>
    ModuleG name PName -> ParseM [ModuleG name PName]
    desugarMod ModuleG name PName
    mo =
      case ModuleG name PName -> ModuleDefinition PName
    forall mname name. ModuleG mname name -> ModuleDefinition name
    mDef ModuleG name PName
    mo of

        FunctorInstance Located (ImpName PName)
    f ModuleInstanceArgs PName
    as ModuleInstance PName
    _ | DefaultInstAnonArg [TopDecl PName]
    lds <- ModuleInstanceArgs PName
    as ->
          do ([ModuleG name PName]
    ms,[TopDecl PName]
    lds') <- Located name
    -> [TopDecl PName]
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    forall name.
    MkAnon name =>
    Located name
    -> [TopDecl PName]
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    desugarTopDs (ModuleG name PName -> Located name
    forall mname name. ModuleG mname name -> Located mname
    mName ModuleG name PName
    mo) [TopDecl PName]
    lds
             case [ModuleG name PName]
    ms of
               ModuleG name PName
    m : [ModuleG name PName]
    _ | InterfaceModule Signature PName
    si <- ModuleG name PName -> ModuleDefinition PName
    forall mname name. ModuleG mname name -> ModuleDefinition name
    mDef ModuleG name PName
    m
                     , Range
    l : [Range]
    _ <- (ParameterType PName -> Range) -> [ParameterType PName] -> [Range]
    forall a b. (a -> b) -> [a] -> [b]
    map (LPName -> Range
    forall a. Located a -> Range
    srcRange (LPName -> Range)
    -> (ParameterType PName -> LPName) -> ParameterType PName -> Range
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParameterType PName -> LPName
    forall name. ParameterType name -> Located name
    ptName) (Signature PName -> [ParameterType PName]
    forall name. Signature name -> [ParameterType name]
    sigTypeParams Signature PName
    si) [Range] -> [Range] -> [Range]
    forall a. [a] -> [a] -> [a]
    ++
                                (ParameterFun PName -> Range) -> [ParameterFun PName] -> [Range]
    forall a b. (a -> b) -> [a] -> [b]
    map (LPName -> Range
    forall a. Located a -> Range
    srcRange (LPName -> Range)
    -> (ParameterFun PName -> LPName) -> ParameterFun PName -> Range
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParameterFun PName -> LPName
    forall name. ParameterFun name -> Located name
    pfName) (Signature PName -> [ParameterFun PName]
    forall name. Signature name -> [ParameterFun name]
    sigFunParams Signature PName
    si) [Range] -> [Range] -> [Range]
    forall a. [a] -> [a] -> [a]
    ++
                                [ Located name -> Range
    forall a. Located a -> Range
    srcRange (ModuleG name PName -> Located name
    forall mname name. ModuleG mname name -> Located mname
    mName ModuleG name PName
    mo) ] ->
                  Range -> [[Char]] -> ParseM ()
    forall a. Range -> [[Char]] -> ParseM a
    errorMessage Range
    l
                    [ [Char]
    "Instantiation of a parameterized module may not itself be "
                      [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "parameterized" ]
               [ModuleG name PName]
    _ -> () -> ParseM ()
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
             let i :: name
    i      = AnonThing -> name -> name
    forall t. MkAnon t => AnonThing -> t -> t
    mkAnon AnonThing
    AnonArg (Located name -> name
    forall a. Located a -> a
    thing (ModuleG name PName -> Located name
    forall mname name. ModuleG mname name -> Located mname
    mName ModuleG name PName
    mo))
                 nm :: Located name
    nm     = Located { srcRange :: Range
    srcRange = Located name -> Range
    forall a. Located a -> Range
    srcRange (ModuleG name PName -> Located name
    forall mname name. ModuleG mname name -> Located mname
    mName ModuleG name PName
    mo), thing :: name
    thing = name
    i }
                 as' :: ModuleInstanceArgs PName
    as'    = Located (ModuleInstanceArg PName) -> ModuleInstanceArgs PName
    forall name.
    Located (ModuleInstanceArg name) -> ModuleInstanceArgs name
    DefaultInstArg (ImpName PName -> ModuleInstanceArg PName
    forall name. ImpName name -> ModuleInstanceArg name
    ModuleArg (ImpName PName -> ModuleInstanceArg PName)
    -> (name -> ImpName PName) -> name -> ModuleInstanceArg PName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . name -> ImpName PName
    forall t. MkAnon t => t -> ImpName PName
    toImpName (name -> ModuleInstanceArg PName)
    -> Located name -> Located (ModuleInstanceArg PName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Located name
    nm)
             [ModuleG name PName] -> ParseM [ModuleG name PName]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ Module { mName :: Located name
    mName = Located name
    nm, mDef :: ModuleDefinition PName
    mDef  = [TopDecl PName] -> ModuleDefinition PName
    forall name. [TopDecl name] -> ModuleDefinition name
    NormalModule [TopDecl PName]
    lds' }
                  , ModuleG name PName
    mo { mDef :: ModuleDefinition PName
    mDef = Located (ImpName PName)
    -> ModuleInstanceArgs PName
    -> ModuleInstance PName
    -> ModuleDefinition PName
    forall name.
    Located (ImpName name)
    -> ModuleInstanceArgs name
    -> ModuleInstance name
    -> ModuleDefinition name
    FunctorInstance Located (ImpName PName)
    f ModuleInstanceArgs PName
    as' ModuleInstance PName
    forall a. Monoid a => a
    mempty }
                  ]

        NormalModule [TopDecl PName]
    ds ->
          do ([ModuleG name PName]
    newMs, [TopDecl PName]
    newDs) <- Located name
    -> [TopDecl PName]
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    forall name.
    MkAnon name =>
    Located name
    -> [TopDecl PName]
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    desugarTopDs (ModuleG name PName -> Located name
    forall mname name. ModuleG mname name -> Located mname
    mName ModuleG name PName
    mo) [TopDecl PName]
    ds
             [ModuleG name PName] -> ParseM [ModuleG name PName]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([ModuleG name PName]
    newMs [ModuleG name PName]
    -> [ModuleG name PName] -> [ModuleG name PName]
    forall a. [a] -> [a] -> [a]
    ++ [ ModuleG name PName
    mo { mDef :: ModuleDefinition PName
    mDef = [TopDecl PName] -> ModuleDefinition PName
    forall name. [TopDecl name] -> ModuleDefinition name
    NormalModule [TopDecl PName]
    newDs } ])

        ModuleDefinition PName
    _ -> [ModuleG name PName] -> ParseM [ModuleG name PName]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ModuleG name PName
    mo]

    desugarTopDs ::
      MkAnon name =>
      Located name ->
      [TopDecl PName] ->
      ParseM ([ModuleG name PName], [TopDecl PName])
    desugarTopDs :: forall name.
    MkAnon name =>
    Located name
    -> [TopDecl PName]
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    desugarTopDs Located name
    ownerName = Signature PName
    -> [TopDecl PName]
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    go Signature PName
    forall {name}. Signature name
    emptySig
      where
      isEmpty :: Signature name -> Bool
    isEmpty Signature name
    s =
        [ParameterType name] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Signature name -> [ParameterType name]
    forall name. Signature name -> [ParameterType name]
    sigTypeParams Signature name
    s) Bool -> Bool -> Bool
    && [Located (Prop name)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Signature name -> [Located (Prop name)]
    forall name. Signature name -> [Located (Prop name)]
    sigConstraints Signature name
    s) Bool -> Bool -> Bool
    && [ParameterFun name] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Signature name -> [ParameterFun name]
    forall name. Signature name -> [ParameterFun name]
    sigFunParams Signature name
    s)

      emptySig :: Signature name
    emptySig = Signature
        { sigImports :: [Located (ImportG (ImpName name))]
    sigImports      = []
        , sigTypeParams :: [ParameterType name]
    sigTypeParams   = []
        , sigDecls :: [SigDecl name]
    sigDecls        = []
        , sigConstraints :: [Located (Prop name)]
    sigConstraints  = []
        , sigFunParams :: [ParameterFun name]
    sigFunParams    = []
        }

      jnSig :: Signature name -> Signature name -> Signature name
    jnSig Signature name
    s1 Signature name
    s2 = Signature { sigImports :: [Located (ImportG (ImpName name))]
    sigImports      = (Signature name -> [Located (ImportG (ImpName name))])
    -> [Located (ImportG (ImpName name))]
    forall {a}. (Signature name -> [a]) -> [a]
    j Signature name -> [Located (ImportG (ImpName name))]
    forall name. Signature name -> [Located (ImportG (ImpName name))]
    sigImports
                              , sigTypeParams :: [ParameterType name]
    sigTypeParams   = (Signature name -> [ParameterType name]) -> [ParameterType name]
    forall {a}. (Signature name -> [a]) -> [a]
    j Signature name -> [ParameterType name]
    forall name. Signature name -> [ParameterType name]
    sigTypeParams
                              , sigDecls :: [SigDecl name]
    sigDecls        = (Signature name -> [SigDecl name]) -> [SigDecl name]
    forall {a}. (Signature name -> [a]) -> [a]
    j Signature name -> [SigDecl name]
    forall name. Signature name -> [SigDecl name]
    sigDecls
                              , sigConstraints :: [Located (Prop name)]
    sigConstraints  = (Signature name -> [Located (Prop name)]) -> [Located (Prop name)]
    forall {a}. (Signature name -> [a]) -> [a]
    j Signature name -> [Located (Prop name)]
    forall name. Signature name -> [Located (Prop name)]
    sigConstraints
                              , sigFunParams :: [ParameterFun name]
    sigFunParams    = (Signature name -> [ParameterFun name]) -> [ParameterFun name]
    forall {a}. (Signature name -> [a]) -> [a]
    j Signature name -> [ParameterFun name]
    forall name. Signature name -> [ParameterFun name]
    sigFunParams
                              }

          where
          j :: (Signature name -> [a]) -> [a]
    j Signature name -> [a]
    f = Signature name -> [a]
    f Signature name
    s1 [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ Signature name -> [a]
    f Signature name
    s2

      addI :: Located (ImportG (ImpName name))
    -> Signature name -> Signature name
    addI Located (ImportG (ImpName name))
    i Signature name
    s = Signature name
    s { sigImports :: [Located (ImportG (ImpName name))]
    sigImports = Located (ImportG (ImpName name))
    i Located (ImportG (ImpName name))
    -> [Located (ImportG (ImpName name))]
    -> [Located (ImportG (ImpName name))]
    forall a. a -> [a] -> [a]
    : Signature name -> [Located (ImportG (ImpName name))]
    forall name. Signature name -> [Located (ImportG (ImpName name))]
    sigImports Signature name
    s }

      go :: Signature PName
    -> [TopDecl PName]
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    go Signature PName
    sig [TopDecl PName]
    ds =
        case [TopDecl PName]
    ds of

          []
            | Signature PName -> Bool
    forall {name}. Signature name -> Bool
    isEmpty Signature PName
    sig -> ([ModuleG name PName], [TopDecl PName])
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([],[])
            | Bool
    otherwise ->
              do let nm :: Located name
    nm = AnonThing -> name -> name
    forall t. MkAnon t => AnonThing -> t -> t
    mkAnon AnonThing
    AnonIfaceMod (name -> name) -> Located name -> Located name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Located name
    ownerName
                 ([ModuleG name PName], [TopDecl PName])
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ( [ Module { mName :: Located name
    mName = Located name
    nm
                                 , mDef :: ModuleDefinition PName
    mDef = Signature PName -> ModuleDefinition PName
    forall name. Signature name -> ModuleDefinition name
    InterfaceModule Signature PName
    sig
                                 }
                         ]
                      , [ ModParam PName -> TopDecl PName
    forall name. ModParam name -> TopDecl name
    DModParam
                          ModParam
                            { mpSignature :: Located (ImpName PName)
    mpSignature = name -> ImpName PName
    forall t. MkAnon t => t -> ImpName PName
    toImpName (name -> ImpName PName) -> Located name -> Located (ImpName PName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Located name
    nm
                            , mpAs :: Maybe ModName
    mpAs        = Maybe ModName
    forall a. Maybe a
    Nothing
                            , mpName :: Ident
    mpName      = Located (ImpName PName) -> Maybe (Located ModName) -> Ident
    mkModParamName (name -> ImpName PName
    forall t. MkAnon t => t -> ImpName PName
    toImpName (name -> ImpName PName) -> Located name -> Located (ImpName PName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Located name
    nm)
                                                                            Maybe (Located ModName)
    forall a. Maybe a
    Nothing
                            , mpDoc :: Maybe (Located Text)
    mpDoc       = Maybe (Located Text)
    forall a. Maybe a
    Nothing
                            , mpRenaming :: ModuleInstance PName
    mpRenaming  = ModuleInstance PName
    forall a. Monoid a => a
    mempty
                            }
                          ]
                      )

          TopDecl PName
    d : [TopDecl PName]
    more ->
            let cont :: [TopDecl PName]
    -> Signature PName
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    cont [TopDecl PName]
    emit Signature PName
    sig' =
                  do ([ModuleG name PName]
    ms,[TopDecl PName]
    ds') <- Signature PName
    -> [TopDecl PName]
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    go Signature PName
    sig' [TopDecl PName]
    more
                     ([ModuleG name PName], [TopDecl PName])
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([ModuleG name PName]
    ms, [TopDecl PName]
    emit [TopDecl PName] -> [TopDecl PName] -> [TopDecl PName]
    forall a. [a] -> [a] -> [a]
    ++ [TopDecl PName]
    ds')
            in
            case TopDecl PName
    d of

              DImport Located (ImportG (ImpName PName))
    i | ImpTop ModName
    _ <- ImportG (ImpName PName) -> ImpName PName
    forall mname. ImportG mname -> mname
    iModule (Located (ImportG (ImpName PName)) -> ImportG (ImpName PName)
    forall a. Located a -> a
    thing Located (ImportG (ImpName PName))
    i)
                        , Maybe (ModuleInstanceArgs PName)
    Nothing  <- ImportG (ImpName PName) -> Maybe (ModuleInstanceArgs PName)
    forall mname. ImportG mname -> Maybe (ModuleInstanceArgs PName)
    iInst (Located (ImportG (ImpName PName)) -> ImportG (ImpName PName)
    forall a. Located a -> a
    thing Located (ImportG (ImpName PName))
    i) ->
                [TopDecl PName]
    -> Signature PName
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    cont [TopDecl PName
    d] (Located (ImportG (ImpName PName))
    -> Signature PName -> Signature PName
    forall {name}.
    Located (ImportG (ImpName name))
    -> Signature name -> Signature name
    addI Located (ImportG (ImpName PName))
    i Signature PName
    sig)

              DImport Located (ImportG (ImpName PName))
    i | Just ModuleInstanceArgs PName
    inst <- ImportG (ImpName PName) -> Maybe (ModuleInstanceArgs PName)
    forall mname. ImportG mname -> Maybe (ModuleInstanceArgs PName)
    iInst (Located (ImportG (ImpName PName)) -> ImportG (ImpName PName)
    forall a. Located a -> a
    thing Located (ImportG (ImpName PName))
    i) ->
                do [TopDecl PName]
    newDs <- Located (ImportG (ImpName PName))
    -> ModuleInstanceArgs PName -> ParseM [TopDecl PName]
    desugarInstImport Located (ImportG (ImpName PName))
    i ModuleInstanceArgs PName
    inst
                   [TopDecl PName]
    -> Signature PName
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    cont [TopDecl PName]
    newDs Signature PName
    sig

              DParamDecl Range
    _ Signature PName
    ds' -> [TopDecl PName]
    -> Signature PName
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    cont [] (Signature PName -> Signature PName -> Signature PName
    forall {name}. Signature name -> Signature name -> Signature name
    jnSig Signature PName
    ds' Signature PName
    sig)

              DModule TopLevel (NestedModule PName)
    tl | NestedModule ModuleG PName PName
    mo <- TopLevel (NestedModule PName) -> NestedModule PName
    forall a. TopLevel a -> a
    tlValue TopLevel (NestedModule PName)
    tl ->
                do [ModuleG PName PName]
    ms <- ModuleG PName PName -> ParseM [ModuleG PName PName]
    forall name.
    MkAnon name =>
    ModuleG name PName -> ParseM [ModuleG name PName]
    desugarMod ModuleG PName PName
    mo
                   [TopDecl PName]
    -> Signature PName
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    cont [ TopLevel (NestedModule PName) -> TopDecl PName
    forall name. TopLevel (NestedModule name) -> TopDecl name
    DModule TopLevel (NestedModule PName)
    tl { tlValue :: NestedModule PName
    tlValue = ModuleG PName PName -> NestedModule PName
    forall name. ModuleG name name -> NestedModule name
    NestedModule ModuleG PName PName
    m } | ModuleG PName PName
    m <- [ModuleG PName PName]
    ms ] Signature PName
    sig

              TopDecl PName
    _ -> [TopDecl PName]
    -> Signature PName
    -> ParseM ([ModuleG name PName], [TopDecl PName])
    cont [TopDecl PName
    d] Signature PName
    sig

    desugarInstImport ::
      Located (ImportG (ImpName PName)) {- ^ The import -} ->
      ModuleInstanceArgs PName          {- ^ The insantiation -} ->
      ParseM [TopDecl PName]
    desugarInstImport :: Located (ImportG (ImpName PName))
    -> ModuleInstanceArgs PName -> ParseM [TopDecl PName]
    desugarInstImport Located (ImportG (ImpName PName))
    i ModuleInstanceArgs PName
    inst =
      do [ModuleG PName PName]
    ms <- ModuleG PName PName -> ParseM [ModuleG PName PName]
    forall name.
    MkAnon name =>
    ModuleG name PName -> ParseM [ModuleG name PName]
    desugarMod
               Module { mName :: LPName
    mName = Located (ImportG (ImpName PName))
    i { thing :: PName
    thing = PName
    iname }
                      , mDef :: ModuleDefinition PName
    mDef  = Located (ImpName PName)
    -> ModuleInstanceArgs PName
    -> ModuleInstance PName
    -> ModuleDefinition PName
    forall name.
    Located (ImpName name)
    -> ModuleInstanceArgs name
    -> ModuleInstance name
    -> ModuleDefinition name
    FunctorInstance
                                  (ImportG (ImpName PName) -> ImpName PName
    forall mname. ImportG mname -> mname
    iModule (ImportG (ImpName PName) -> ImpName PName)
    -> Located (ImportG (ImpName PName)) -> Located (ImpName PName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Located (ImportG (ImpName PName))
    i) ModuleInstanceArgs PName
    inst ModuleInstance PName
    forall name. Ord name => ModuleInstance name
    emptyModuleInstance
                      }
         [TopDecl PName] -> ParseM [TopDecl PName]
    forall a. a -> ParseM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Located (ImportG (ImpName PName)) -> TopDecl PName
    forall name. Located (ImportG (ImpName name)) -> TopDecl name
    DImport (ImportG (ImpName PName) -> ImportG (ImpName PName)
    forall {mname}. ImportG mname -> ImportG (ImpName PName)
    newImp (ImportG (ImpName PName) -> ImportG (ImpName PName))
    -> Located (ImportG (ImpName PName))
    -> Located (ImportG (ImpName PName))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Located (ImportG (ImpName PName))
    i) TopDecl PName -> [TopDecl PName] -> [TopDecl PName]
    forall a. a -> [a] -> [a]
    : (ModuleG PName PName -> TopDecl PName)
    -> [ModuleG PName PName] -> [TopDecl PName]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleG PName PName -> TopDecl PName
    forall {name}. ModuleG name name -> TopDecl name
    modTop [ModuleG PName PName]
    ms)

      where
      imp :: ImportG (ImpName PName)
    imp = Located (ImportG (ImpName PName)) -> ImportG (ImpName PName)
    forall a. Located a -> a
    thing Located (ImportG (ImpName PName))
    i
      iname :: PName
    iname = Ident -> PName
    mkUnqual
            (Ident -> PName) -> Ident -> PName
    forall a b. (a -> b) -> a -> b
    $ Text -> Ident
    mkIdent
            (Text -> Ident) -> Text -> Ident
    forall a b. (a -> b) -> a -> b
    $ Text
    "import of " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    nm Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " at " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Text
    Text.pack (Doc -> [Char]
    forall a. Show a => a -> [Char]
    show (Range -> Doc
    forall a. PP a => a -> Doc
    pp (Located (ImportG (ImpName PName)) -> Range
    forall a. Located a -> Range
    srcRange Located (ImportG (ImpName PName))
    i)))
        where
        nm :: Text
    nm = case ImportG (ImpName PName) -> ImpName PName
    forall mname. ImportG mname -> mname
    iModule ImportG (ImpName PName)
    imp of
               ImpTop ModName
    f    -> ModName -> Text
    modNameToText ModName
    f
               ImpNested PName
    n -> Text
    "submodule " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Text
    Text.pack (Doc -> [Char]
    forall a. Show a => a -> [Char]
    show (PName -> Doc
    forall a. PP a => a -> Doc
    pp PName
    n))

      newImp :: ImportG mname -> ImportG (ImpName PName)
    newImp ImportG mname
    d = ImportG mname
    d { iModule :: ImpName PName
    iModule = PName -> ImpName PName
    forall name. name -> ImpName name
    ImpNested PName
    iname
                   , iInst :: Maybe (ModuleInstanceArgs PName)
    iInst   = Maybe (ModuleInstanceArgs PName)
    forall a. Maybe a
    Nothing
                   }

      modTop :: ModuleG name name -> TopDecl name
    modTop ModuleG name name
    m = TopLevel (NestedModule name) -> TopDecl name
    forall name. TopLevel (NestedModule name) -> TopDecl name
    DModule TopLevel
                           { tlExport :: ExportType
    tlExport = ExportType
    Private
                           , tlDoc :: Maybe (Located Text)
    tlDoc    = Maybe (Located Text)
    forall a. Maybe a
    Nothing
                           , tlValue :: NestedModule name
    tlValue  = ModuleG name name -> NestedModule name
    forall name. ModuleG name name -> NestedModule name
    NestedModule ModuleG name name
    m
                           }