    -- |
    -- 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 OverloadedStrings #-}
    module Cryptol.Parser.ParserUtils where

    import Data.Maybe(fromMaybe)
    import Data.Bits(testBit,setBit)
    import Control.Monad(liftM,ap,unless,guard)
    import           Data.Text(Text)
    import qualified Data.Text as T
    import qualified Data.Map as Map

    import GHC.Generics (Generic)
    import Control.DeepSeq

    import Prelude ()
    import Prelude.Compat

    import Cryptol.Parser.AST
    import Cryptol.Parser.Lexer
    import Cryptol.Parser.Position
    import Cryptol.Parser.Utils (translateExprToNumT,widthIdent)
    import Cryptol.Utils.Ident(packModName)
    import Cryptol.Utils.PP
    import Cryptol.Utils.Panic

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

    parse :: Config -> ParseM a -> Text -> Either ParseError a
    parse :: Config -> ParseM a -> Text -> Either ParseError a
    parse cfg :: Config
    cfg p :: ParseM a
    p cs :: 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 $WS :: Maybe (Located Token) -> [Located Token] -> Int -> S
    S { sPrevTok :: Maybe (Located Token)
    sPrevTok = Maybe (Located Token)
    forall a. Maybe a
    Nothing
                                                , sTokens :: [Located Token]
    sTokens = [Located Token]
    toks
                                                , sNextTyParamNum :: Int
    sNextTyParamNum = 0
                                                } of
                          Left err :: ParseError
    err    -> ParseError -> Either ParseError a
    forall a b. a -> Either a b
    Left ParseError
    err
                          Right (a :: a
    a,_) -> a -> Either ParseError a
    forall a b. b -> Either a b
    Right a
    a
      where (toks :: [Located Token]
    toks,eofPos :: 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 { 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 :: (Located Token -> ParseM a) -> ParseM a
    lexerP k :: 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
    $ \cfg :: Config
    cfg p :: Position
    p s :: S
    s ->
      case S -> [Located Token]
    sTokens S
    s of
        t :: Located Token
    t : _ | Err e :: 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 -> String -> ParseError
    HappyErrorMsg (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    t) (String -> ParseError) -> String -> ParseError
    forall a b. (a -> b) -> a -> b
    $
             case TokenErr
    e of
               UnterminatedComment -> "unterminated comment"
               UnterminatedString  -> "unterminated string"
               UnterminatedChar    -> "unterminated character"
               InvalidString       -> "invalid string literal:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                        Text -> String
    T.unpack (Token -> Text
    tokenText Token
    it)
               InvalidChar         -> "invalid character literal:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                        Text -> String
    T.unpack (Token -> Text
    tokenText Token
    it)
               LexicalError        -> "unrecognized character:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                        Text -> String
    T.unpack (Token -> Text
    tokenText Token
    it)
          where it :: Token
    it = Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    t

        t :: Located Token
    t : more :: [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 (String -> Position -> ParseError
    HappyOutOfTokens (Config -> String
    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 -> String -> String
    [ParseError] -> String -> String
    ParseError -> String
    (Int -> ParseError -> String -> String)
    -> (ParseError -> String)
    -> ([ParseError] -> String -> String)
    -> Show ParseError
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    showList :: [ParseError] -> String -> String
    $cshowList :: [ParseError] -> String -> String
    show :: ParseError -> String
    $cshow :: ParseError -> String
    showsPrec :: Int -> ParseError -> String -> String
    $cshowsPrec :: Int -> ParseError -> String -> String
    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
    $cto :: forall x. Rep ParseError x -> ParseError
    $cfrom :: forall x. ParseError -> Rep ParseError x
    Generic, ParseError -> ()
    (ParseError -> ()) -> NFData ParseError
    forall a. (a -> ()) -> NFData a
    rnf :: ParseError -> ()
    $crnf :: 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 path :: String
    path ltok :: Located Token
    ltok)
      | Err _ <- Token -> TokenT
    tokenType Token
    tok =
        String -> Doc
    text "Parse error at" Doc -> Doc -> Doc
    <+>
        String -> Doc
    text String
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    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 DocStr <- Token -> TokenT
    tokenType Token
    tok =
        "Unexpected documentation (/**) comment at" Doc -> Doc -> Doc
    <+>
        String -> Doc
    text String
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    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
    nest 2
          "Documentation comments need to be followed by something to document."

      | Bool
    otherwise =
        String -> Doc
    text "Parse error at" Doc -> Doc -> Doc
    <+>
        String -> Doc
    text String
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    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
    nest 2 (String -> Doc
    text "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 path :: String
    path pos :: Position
    pos) =
      String -> Doc
    text "Unexpected end of file at:" Doc -> Doc -> Doc
    <+>
        String -> Doc
    text String
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    char ':' Doc -> Doc -> Doc
    <.> Position -> Doc
    forall a. PP a => a -> Doc
    pp Position
    pos

    ppError (HappyErrorMsg p :: Range
    p x :: String
    x)  = String -> Doc
    text "Parse error at" Doc -> Doc -> Doc
    <+> Range -> Doc
    forall a. PP a => a -> Doc
    pp Range
    p Doc -> Doc -> Doc
    $$ Int -> Doc -> Doc
    nest 2 (String -> Doc
    text String
    x)

    ppError (HappyUnexpected path :: String
    path ltok :: Maybe (Located Token)
    ltok e :: String
    e) =
      String -> Doc
    text "Parse error at" Doc -> Doc -> Doc
    <+>
       String -> Doc
    text String
    path Doc -> Doc -> Doc
    <.> Char -> Doc
    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
    nest 2 Doc
    unexp Doc -> Doc -> Doc
    $$
       Int -> Doc -> Doc
    nest 2 ("expected:" Doc -> Doc -> Doc
    <+> String -> Doc
    text String
    e)
      where
      (unexp :: Doc
    unexp,pos :: Position
    pos) =
        case Maybe (Located Token)
    ltok of
          Nothing -> (Doc
    empty,Position
    start)
          Just t :: Located Token
    t  -> ( "unexpected:" Doc -> Doc -> Doc
    <+> String -> Doc
    text (Text -> String
    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 :: (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 :: a -> ParseM a
    pure  = a -> ParseM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
      <*> :: 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 :: a -> ParseM a
    return a :: a
    a  = (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    forall a.
    (Config -> Position -> S -> Either ParseError (a, S)) -> ParseM a
    P (\_ _ s :: S
    s -> (a, S) -> Either ParseError (a, S)
    forall a b. b -> Either a b
    Right (a
    a,S
    s))
      m :: ParseM a
    m >>= :: ParseM a -> (a -> ParseM b) -> ParseM b
    >>= k :: 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 (\cfg :: Config
    cfg p :: Position
    p s1 :: 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 e :: ParseError
    e       -> ParseError -> Either ParseError (b, S)
    forall a b. a -> Either a b
    Left ParseError
    e
                                Right (a :: a
    a,s2 :: 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 MonadFail ParseM where
      fail :: String -> ParseM a
    fail s :: String
    s    = String -> [String] -> ParseM a
    forall a. HasCallStack => String -> [String] -> a
    panic "[Parser] fail" [String
    s]

    happyError :: ParseM a
    happyError :: 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
    $ \cfg :: Config
    cfg _ s :: S
    s ->
      case S -> Maybe (Located Token)
    sPrevTok S
    s of
        Just t :: Located Token
    t  -> ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left (String -> Located Token -> ParseError
    HappyError (Config -> String
    cfgSource Config
    cfg) Located Token
    t)
        Nothing ->
          ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left (Range -> String -> ParseError
    HappyErrorMsg Range
    emptyRange "Parse error at the beginning of the file")

    errorMessage :: Range -> String -> ParseM a
    errorMessage :: Range -> String -> ParseM a
    errorMessage r :: Range
    r x :: String
    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
    $ \_ _ _ -> ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left (Range -> String -> ParseError
    HappyErrorMsg Range
    r String
    x)

    customError :: String -> Located Token -> ParseM a
    customError :: String -> Located Token -> ParseM a
    customError x :: String
    x t :: 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
    $ \_ _ _ -> ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left (Range -> String -> ParseError
    HappyErrorMsg (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    t) String
    x)

    expected :: String -> ParseM a
    expected :: String -> ParseM a
    expected x :: String
    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
    $ \cfg :: Config
    cfg _ s :: S
    s ->
                        ParseError -> Either ParseError (a, S)
    forall a b. a -> Either a b
    Left (String -> Maybe (Located Token) -> String -> ParseError
    HappyUnexpected (Config -> String
    cfgSource Config
    cfg) (S -> Maybe (Located Token)
    sPrevTok S
    s) String
    x)

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

    -- 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 xs :: [TParam PName]
    xs ps :: [Prop PName]
    ps t :: 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 l :: Located Token
    l = case Located Token -> Token
    forall a. Located a -> a
    thing Located Token
    l of
                  Token (Ident [] x :: Text
    x) _ -> Ident -> PName
    mkUnqual (Text -> Ident
    mkIdent Text
    x)
                  _ -> String -> [String] -> PName
    forall a. HasCallStack => String -> [String] -> a
    panic "[Parser] getName" ["not an Ident:", Located Token -> String
    forall a. Show a => a -> String
    show Located Token
    l]

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

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

    numLit :: TokenT -> Expr PName
    numLit :: TokenT -> Expr PName
    numLit (Num x :: Integer
    x base :: Int
    base digs :: Int
    digs)
      | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 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 (Int -> NumInfo
    BinLit Int
    digs)
      | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 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 (Int -> NumInfo
    OctLit Int
    digs)
      | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 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 NumInfo
    DecLit
      | Int
    base Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 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 (Int -> NumInfo
    HexLit Int
    digs)

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

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

    mkFixity :: Assoc -> Located Token -> [LPName] -> ParseM (Decl PName)
    mkFixity :: Assoc -> Located Token -> [LPName] -> ParseM (Decl PName)
    mkFixity assoc :: Assoc
    assoc tok :: Located Token
    tok qns :: [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
    >= 1 Bool -> Bool -> Bool
    && Integer
    l Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 100)
              (Range -> String -> ParseM ()
    forall a. Range -> String -> ParseM a
    errorMessage (Located Token -> Range
    forall a. Located a -> Range
    srcRange Located Token
    tok) "Fixity levels must be between 1 and 100")
         Decl PName -> ParseM (Decl PName)
    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)

    mkTupleSel :: Range -> Integer -> ParseM (Located Selector)
    mkTupleSel :: Range -> Integer -> ParseM (Located Selector)
    mkTupleSel pos :: Range
    pos n :: Integer
    n
      | Integer
    n Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 = Range -> String -> ParseM (Located Selector)
    forall a. Range -> String -> ParseM a
    errorMessage Range
    pos
                 (Integer -> String
    forall a. Show a => a -> String
    show Integer
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " is not a valid tuple selector (they start from 0).")
      | Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    asInt Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Integer
    n  = Range -> String -> ParseM (Located Selector)
    forall a. Range -> String -> ParseM a
    errorMessage Range
    pos "Tuple selector is too large."
      | Bool
    otherwise             = Located Selector -> ParseM (Located Selector)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Located Selector -> ParseM (Located Selector))
    -> Located Selector -> ParseM (Located Selector)
    forall a b. (a -> b) -> a -> b
    $ Range -> Selector -> Located Selector
    forall a. Range -> a -> Located a
    Located Range
    pos (Selector -> Located Selector) -> Selector -> Located Selector
    forall a b. (a -> b) -> a -> b
    $ Int -> Maybe Int -> Selector
    TupleSel Int
    asInt Maybe Int
    forall a. Maybe a
    Nothing
      where asInt :: Int
    asInt = Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger Integer
    n

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

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

        TParens t :: Type PName
    t    -> Range -> Type PName -> ParseM (Type PName)
    validDemotedType Range
    rng Type PName
    t
        TInfix{}     -> ParseM (Type PName)
    ok

      where bad :: String -> ParseM a
    bad x :: String
    x = Range -> String -> ParseM a
    forall a. Range -> String -> ParseM a
    errorMessage Range
    rng (String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " cannot be demoted.")
            ok :: ParseM (Type PName)
    ok    = Type PName -> ParseM (Type PName)
    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 expression are reversed
    mkEApp :: [Expr PName] -> Expr PName
    mkEApp :: [Expr PName] -> Expr PName
    mkEApp es :: [Expr PName]
    es@(eLast :: Expr PName
    eLast : _) = (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 (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
      eFirst :: Expr PName
    eFirst : rest :: [Expr PName]
    rest = [Expr PName] -> [Expr PName]
    forall a. [a] -> [a]
    reverse [Expr PName]
    es
      f :: Expr PName
    f : xs :: [Expr PName]
    xs        = Expr PName -> [Expr PName] -> [Expr PName]
    cvtTypeParams Expr PName
    eFirst [Expr PName]
    rest

      {- Type applications are parsed as `ETypeVal (TRecord 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 ]
      -}
      cvtTypeParams :: Expr PName -> [Expr PName] -> [Expr PName]
    cvtTypeParams e :: Expr PName
    e [] = [Expr PName
    e]
      cvtTypeParams e :: Expr PName
    e (p :: Expr PName
    p : ps :: [Expr PName]
    ps) =
        case Expr PName -> Maybe [TypeInst PName]
    toTypeParam Expr PName
    p of
          Just fs :: [TypeInst PName]
    fs -> Expr PName -> [Expr PName] -> [Expr PName]
    cvtTypeParams (Expr PName -> [TypeInst PName] -> Expr PName
    forall n. Expr n -> [TypeInst n] -> Expr n
    EAppT Expr PName
    e [TypeInst PName]
    fs) [Expr PName]
    ps
          Nothing -> Expr PName
    e Expr PName -> [Expr PName] -> [Expr PName]
    forall a. a -> [a] -> [a]
    : Expr PName -> [Expr PName] -> [Expr PName]
    cvtTypeParams Expr PName
    p [Expr PName]
    ps

      toTypeParam :: Expr PName -> Maybe [TypeInst PName]
    toTypeParam e :: Expr PName
    e =
        case Expr PName -> Expr PName
    forall t. AddLoc t => t -> t
    dropLoc Expr PName
    e of
          ETypeVal t :: Type PName
    t -> case Type PName -> Type PName
    forall t. AddLoc t => t -> t
    dropLoc Type PName
    t of
                          TRecord fs :: [Named (Type PName)]
    fs -> [TypeInst PName] -> Maybe [TypeInst PName]
    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 [TypeInst PName]
    forall a. Maybe a
    Nothing
          _          ->  Maybe [TypeInst PName]
    forall a. Maybe a
    Nothing

    mkEApp es :: [Expr PName]
    es        = String -> [String] -> Expr PName
    forall a. HasCallStack => String -> [String] -> a
    panic "[Parser] mkEApp" ["Unexpected:", [Expr PName] -> String
    forall a. Show a => a -> String
    show [Expr PName]
    es]

    unOp :: Expr PName -> Expr PName -> Expr PName
    unOp :: Expr PName -> Expr PName -> Expr PName
    unOp f :: Expr PName
    f x :: 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 x :: Expr PName
    x f :: LPName
    f y :: 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 r :: Range
    r e1 :: Expr PName
    e1 e2 :: Maybe (Expr PName)
    e2 e3 :: 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 (e1' :: Expr PName
    e1', t :: Type PName
    t), Nothing, 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)
        (Nothing, Just (e2' :: Expr PName
    e2', t :: Type PName
    t), 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)
        (Nothing, Nothing, Just (e3' :: Expr PName
    e3', t :: 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)
        (Nothing, Nothing, 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
        _ -> Range -> String -> ParseM (Expr PName)
    forall a. Range -> String -> ParseM a
    errorMessage Range
    r "A sequence enumeration may have at most one element type annotation."
      where
        asETyped :: Expr n -> Maybe (Expr n, Type n)
    asETyped (ELocated e :: Expr n
    e _) = Expr n -> Maybe (Expr n, Type n)
    asETyped Expr n
    e
        asETyped (ETyped e :: Expr n
    e t :: 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 _ = 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 r :: Range
    r e1 :: Expr PName
    e1 e2 :: Maybe (Expr PName)
    e2 e3 :: Expr PName
    e3 t :: 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 (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)
    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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Maybe (Type PName) -> ParseM (Maybe (Type PName))
    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 r :: Range
    r expr :: Expr PName
    expr =
      case Expr PName -> Maybe (Type PName)
    translateExprToNumT Expr PName
    expr of
        Just t :: Type PName
    t -> Type PName -> ParseM (Type PName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type PName
    t
        Nothing -> ParseM (Type PName)
    forall a. ParseM a
    bad
      where
      bad :: ParseM a
    bad = Range -> String -> ParseM a
    forall a. Range -> String -> 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)) (String -> ParseM a) -> String -> ParseM a
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines
            [ "The boundaries of .. sequences should be valid numeric types."
            , "The expression `" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Expr PName -> String
    forall a. Show a => a -> String
    show Expr PName
    expr String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "` is not."
            ]

    -- | WARNING: This is a bit of a hack.
    -- It is used to represent anonymous type applications.
    anonRecord :: Maybe Range -> [Type PName] -> Type PName
    anonRecord :: Maybe Range -> [Type PName] -> Type PName
    anonRecord ~(Just r :: Range
    r) ts :: [Type PName]
    ts = [Named (Type PName)] -> Type PName
    forall n. [Named (Type n)] -> Type n
    TRecord ((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)
      where noName :: Located Ident
    noName    = $WLocated :: forall a. Range -> a -> Located a
    Located { srcRange :: Range
    srcRange = Range
    r, thing :: Ident
    thing = Text -> Ident
    mkIdent (String -> Text
    T.pack "") }
            toField :: a -> Named a
    toField t :: a
    t = Named :: forall a. Located Ident -> a -> Named a
    Named { name :: Located Ident
    name = Located Ident
    noName, value :: a
    value = a
    t }

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

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

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

    mkParType :: Maybe (Located String) ->
                 Located PName ->
                 Located Kind ->
                 ParseM (TopDecl PName)
    mkParType :: Maybe (Located String)
    -> LPName -> Located Kind -> ParseM (TopDecl PName)
    mkParType mbDoc :: Maybe (Located String)
    mbDoc n :: LPName
    n k :: 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
    $ \_ _ s :: 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
    + 1 })
         TopDecl PName -> ParseM (TopDecl PName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ParameterType PName -> TopDecl PName
    forall name. ParameterType name -> TopDecl name
    DParameterType
                 $WParameterType :: forall name.
    Located name
    -> Kind
    -> Maybe String
    -> Maybe Fixity
    -> Int
    -> ParameterType name
    ParameterType { ptName :: LPName
    ptName    = LPName
    n
                               , ptKind :: Kind
    ptKind    = Located Kind -> Kind
    forall a. Located a -> a
    thing Located Kind
    k
                               , ptDoc :: Maybe String
    ptDoc     = Located String -> String
    forall a. Located a -> a
    thing (Located String -> String)
    -> Maybe (Located String) -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Located String)
    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 e :: 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 (Decl d :: 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 }
      change (DPrimType t :: 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 }
      change (TDNewtype n :: 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 }
      change td :: TopDecl name
    td@Include{}  = TopDecl name
    td
      change (DParameterType {}) = String -> [String] -> TopDecl name
    forall a. HasCallStack => String -> [String] -> a
    panic "changeExport" ["private type parameter?"]
      change (DParameterFun {})  = String -> [String] -> TopDecl name
    forall a. HasCallStack => String -> [String] -> a
    panic "changeExport" ["private value parameter?"]
      change (DParameterConstraint {}) =
        String -> [String] -> TopDecl name
    forall a. HasCallStack => String -> [String] -> a
    panic "changeExport" ["private type constraint parameter?"]

    mkTypeInst :: Named (Type PName) -> TypeInst PName
    mkTypeInst :: Named (Type PName) -> TypeInst PName
    mkTypeInst x :: 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 } k :: Maybe Kind
    k
      | Ident
    n Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    widthIdent = Range -> String -> ParseM (TParam PName)
    forall a. Range -> String -> ParseM a
    errorMessage Range
    rng "`width` is not a valid type parameter name."
      | Bool
    otherwise       = TParam PName -> ParseM (TParam PName)
    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 :: Located PName -> [TParam PName] -> Type PName -> ParseM (Decl PName)
    mkTySyn :: LPName -> [TParam PName] -> Type PName -> ParseM (Decl PName)
    mkTySyn ln :: LPName
    ln ps :: [TParam PName]
    ps b :: Type PName
    b
      | PName -> Ident
    getIdent (LPName -> PName
    forall a. Located a -> a
    thing LPName
    ln) Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    widthIdent =
        Range -> String -> ParseM (Decl PName)
    forall a. Range -> String -> ParseM a
    errorMessage (LPName -> Range
    forall a. Located a -> Range
    srcRange LPName
    ln) "`width` is not a valid type synonym name."

      | Bool
    otherwise =
        Decl PName -> ParseM (Decl PName)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Decl PName -> ParseM (Decl PName))
    -> Decl PName -> ParseM (Decl PName)
    forall a b. (a -> b) -> a -> b
    $ TySyn PName -> Decl PName
    forall name. TySyn name -> Decl name
    DType (TySyn PName -> Decl PName) -> TySyn PName -> Decl PName
    forall a b. (a -> b) -> a -> b
    $ LPName
    -> Maybe Fixity -> [TParam PName] -> Type PName -> TySyn PName
    forall n.
    Located n -> Maybe Fixity -> [TParam n] -> Type n -> TySyn n
    TySyn LPName
    ln Maybe Fixity
    forall a. Maybe a
    Nothing [TParam PName]
    ps Type PName
    b

    mkPropSyn :: Located PName -> [TParam PName] -> Type PName -> ParseM (Decl PName)
    mkPropSyn :: LPName -> [TParam PName] -> Type PName -> ParseM (Decl PName)
    mkPropSyn ln :: LPName
    ln ps :: [TParam PName]
    ps b :: Type PName
    b
      | PName -> Ident
    getIdent (LPName -> PName
    forall a. Located a -> a
    thing LPName
    ln) Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    widthIdent =
        Range -> String -> ParseM (Decl PName)
    forall a. Range -> String -> ParseM a
    errorMessage (LPName -> Range
    forall a. Located a -> Range
    srcRange LPName
    ln) "`width` is not a valid constraint synonym name."

      | Bool
    otherwise =
        PropSyn PName -> Decl PName
    forall name. PropSyn name -> Decl name
    DProp (PropSyn PName -> Decl PName)
    -> (Located [Prop PName] -> PropSyn PName)
    -> Located [Prop PName]
    -> Decl PName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LPName
    -> Maybe Fixity -> [TParam PName] -> [Prop PName] -> PropSyn PName
    forall n.
    Located n -> Maybe Fixity -> [TParam n] -> [Prop n] -> PropSyn n
    PropSyn LPName
    ln Maybe Fixity
    forall a. Maybe a
    Nothing [TParam PName]
    ps ([Prop PName] -> PropSyn PName)
    -> (Located [Prop PName] -> [Prop PName])
    -> Located [Prop PName]
    -> PropSyn PName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located [Prop PName] -> [Prop PName]
    forall a. Located a -> a
    thing (Located [Prop PName] -> Decl PName)
    -> ParseM (Located [Prop PName]) -> ParseM (Decl PName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Type PName -> ParseM (Located [Prop PName])
    mkProp Type PName
    b

    polyTerm :: Range -> Integer -> Integer -> ParseM (Bool, Integer)
    polyTerm :: Range -> Integer -> Integer -> ParseM (Bool, Integer)
    polyTerm rng :: Range
    rng k :: Integer
    k p :: Integer
    p
      | Integer
    k Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0          = (Bool, Integer) -> ParseM (Bool, Integer)
    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
    == 1          = (Bool, Integer) -> ParseM (Bool, Integer)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True, Integer
    p)
      | Bool
    otherwise       = Range -> String -> ParseM (Bool, Integer)
    forall a. Range -> String -> ParseM a
    errorMessage Range
    rng "Invalid polynomial coefficient"

    mkPoly :: Range -> [ (Bool,Integer) ] -> ParseM (Expr PName)
    mkPoly :: Range -> [(Bool, Integer)] -> ParseM (Expr PName)
    mkPoly rng :: Range
    rng terms :: [(Bool, Integer)]
    terms = Integer -> [Int] -> ParseM (Expr PName)
    forall n. Integer -> [Int] -> ParseM (Expr n)
    mk 0 ((Integer -> Int) -> [Integer] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger [Integer]
    bits)
      where
      w :: Int
    w    = case [(Bool, Integer)]
    terms of
               [] -> 0
               _  -> 1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (((Bool, Integer) -> Int) -> [(Bool, Integer)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger (Integer -> Int)
    -> ((Bool, Integer) -> Integer) -> (Bool, Integer) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool, Integer) -> Integer
    forall a b. (a, b) -> b
    snd) [(Bool, Integer)]
    terms)
      bits :: [Integer]
    bits = [ Integer
    n | (True,n :: Integer
    n) <- [(Bool, Integer)]
    terms ]

      mk :: Integer -> [Int] -> ParseM (Expr n)
    mk res :: Integer
    res []         = Expr n -> ParseM (Expr n)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Expr n -> ParseM (Expr n)) -> Expr n -> ParseM (Expr n)
    forall a b. (a -> b) -> a -> b
    $ Literal -> Expr n
    forall n. Literal -> Expr n
    ELit (Literal -> Expr n) -> Literal -> Expr n
    forall a b. (a -> b) -> a -> b
    $ Integer -> NumInfo -> Literal
    ECNum Integer
    res (Int -> NumInfo
    PolyLit Int
    w)
      mk res :: Integer
    res (n :: Int
    n : ns :: [Int]
    ns)
        | Integer -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    testBit Integer
    res Int
    n = Range -> String -> ParseM (Expr n)
    forall a. Range -> String -> ParseM a
    errorMessage Range
    rng
                           ("Polynomial contains multiple terms with exponent "
                                                                        String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n)
        | Bool
    otherwise     = Integer -> [Int] -> ParseM (Expr n)
    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 f :: LPName
    f ps :: [Pattern PName]
    ps e :: Expr PName
    e = Bind PName -> Decl PName
    forall name. Bind name -> Decl name
    DBind Bind :: forall name.
    Located name
    -> [Pattern name]
    -> Located (BindDef name)
    -> Maybe (Schema name)
    -> Bool
    -> Maybe Fixity
    -> [Pragma]
    -> Bool
    -> Maybe String
    -> Bind name
    Bind { bName :: 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 String
    bDoc        = Maybe String
    forall a. Maybe a
    Nothing
                                   }

    -- 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 f :: LPName
    f (ps :: [Pattern PName]
    ps, ixs :: [Pattern PName]
    ixs) e :: Expr PName
    e =
      Bind PName -> Decl PName
    forall name. Bind name -> Decl name
    DBind Bind :: forall name.
    Located name
    -> [Pattern name]
    -> Located (BindDef name)
    -> Maybe (Schema name)
    -> Bool
    -> Maybe Fixity
    -> [Pragma]
    -> Bool
    -> Maybe String
    -> Bind name
    Bind { bName :: 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 String
    bDoc        = Maybe String
    forall a. Maybe a
    Nothing
                 }
      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!
    mkIndexedExpr :: ([Pattern PName], [Pattern PName]) -> Expr PName -> Expr PName
    mkIndexedExpr :: ([Pattern PName], [Pattern PName]) -> Expr PName -> Expr PName
    mkIndexedExpr (ps :: [Pattern PName]
    ps, ixs :: [Pattern PName]
    ixs) body :: Expr PName
    body
      | [Pattern PName] -> 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 = [Pattern PName] -> Expr PName -> Expr PName
    forall n. [Pattern n] -> Expr n -> Expr n
    EFun ([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 pats :: [Pattern PName]
    pats body :: Expr PName
    body =
      (Pattern PName -> Expr PName -> Expr PName)
    -> Expr PName -> [Pattern PName] -> Expr PName
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\pat :: Pattern PName
    pat e :: Expr PName
    e -> Expr PName -> Expr PName
    forall n. Expr n -> Expr n
    EGenerate ([Pattern PName] -> Expr PName -> Expr PName
    forall n. [Pattern n] -> Expr n -> Expr n
    EFun [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 ifThens :: [(Expr PName, Expr PName)]
    ifThens theElse :: Expr PName
    theElse = ((Expr PName, Expr PName) -> Expr PName -> Expr PName)
    -> Expr PName -> [(Expr PName, Expr PName)] -> Expr PName
    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 (cond :: Expr n
    cond, doexpr :: Expr n
    doexpr) elseExpr :: 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

    -- | Generate a signature and a primitive binding.  The reason for generating
    -- both instead of just adding the signature at this point is that it means the
    -- primitive 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.
    mkPrimDecl ::
      Maybe (Located String) -> LPName -> Schema PName -> [TopDecl PName]
    mkPrimDecl :: Maybe (Located String) -> LPName -> Schema PName -> [TopDecl PName]
    mkPrimDecl mbDoc :: Maybe (Located String)
    mbDoc ln :: LPName
    ln sig :: Schema PName
    sig =
      [ Maybe (Located String) -> ExportType -> Decl PName -> TopDecl PName
    exportDecl Maybe (Located String)
    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 :: forall name.
    Located name
    -> [Pattern name]
    -> Located (BindDef name)
    -> Maybe (Schema name)
    -> Bool
    -> Maybe Fixity
    -> [Pragma]
    -> Bool
    -> Maybe String
    -> Bind name
    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
    forall name. BindDef name
    DPrim)
                     , 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 String
    bDoc       = Maybe String
    forall a. Maybe a
    Nothing
                     }
      , Maybe (Located String) -> ExportType -> Decl PName -> TopDecl PName
    exportDecl Maybe (Located String)
    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 String) ->
      Schema PName ->
      Located Kind ->
      ParseM [TopDecl PName]
    mkPrimTypeDecl :: Maybe (Located String)
    -> Schema PName -> Located Kind -> ParseM [TopDecl PName]
    mkPrimTypeDecl mbDoc :: Maybe (Located String)
    mbDoc (Forall as :: [TParam PName]
    as qs :: [Prop PName]
    qs st :: Type PName
    st ~(Just schema_rng :: Range
    schema_rng)) finK :: 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 (n :: LPName
    n,xs :: [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)
    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 -> String -> ParseM ()
    forall a. Range -> String -> ParseM a
    errorMessage Range
    schema_rng "Repeated parameterms."
             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 v :: 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 (k :: TParam PName
    k,tp :: Kind
    tp)  -> (TParam PName, Kind) -> ParseM (TParam PName, Kind)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TParam PName
    k,Kind
    tp)
                           Nothing ->
                            Range -> String -> ParseM (TParam PName, Kind)
    forall a. Range -> String -> ParseM a
    errorMessage
                                (LPName -> Range
    forall a. Located a -> Range
    srcRange LPName
    v)
                                ("Undefined parameter: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Doc -> String
    forall a. Show a => a -> String
    show (PName -> Doc
    forall a. PP a => a -> Doc
    pp (LPName -> PName
    forall a. Located a -> a
    thing LPName
    v)))
             (as' :: [TParam PName]
    as',ins :: [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)
    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 (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 (t :: * -> *) a. Foldable t => t a -> Int
    length [LPName]
    xs) (ParseM () -> ParseM ()) -> ParseM () -> ParseM ()
    forall a b. (a -> b) -> a -> b
    $
               Range -> String -> ParseM ()
    forall a. Range -> String -> ParseM a
    errorMessage Range
    schema_rng "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 (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 (f :: * -> *) a. Applicative f => a -> f a
    pure [ TopLevel (PrimType PName) -> TopDecl PName
    forall name. TopLevel (PrimType name) -> TopDecl name
    DPrimType TopLevel :: forall a. ExportType -> Maybe (Located String) -> a -> TopLevel a
    TopLevel
                      { tlExport :: ExportType
    tlExport = ExportType
    Public
                      , tlDoc :: Maybe (Located String)
    tlDoc    = Maybe (Located String)
    mbDoc
                      , tlValue :: PrimType PName
    tlValue  = PrimType :: forall name.
    Located name
    -> Located Kind
    -> ([TParam name], [Prop name])
    -> Maybe Fixity
    -> PrimType name
    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
                                            }
                     }
                  ]

        Nothing -> Range -> String -> ParseM [TopDecl PName]
    forall a. Range -> String -> ParseM a
    errorMessage Range
    schema_rng "Invalid primitive signature"

      where
      splitT :: Range -> Type a -> Maybe (Located a, [Located a])
    splitT r :: Range
    r ty :: Type a
    ty = case Type a
    ty of
                      TLocated t :: Type a
    t r1 :: Range
    r1 -> Range -> Type a -> Maybe (Located a, [Located a])
    splitT Range
    r1 Type a
    t
                      TUser n :: a
    n ts :: [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 $WLocated :: forall a. Range -> a -> Located a
    Located { srcRange :: Range
    srcRange = Range
    r, thing :: a
    thing = a
    n } [Type a]
    ts
                      TInfix t1 :: Type a
    t1 n :: Located a
    n _ t2 :: 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]
                      _ -> Maybe (Located a, [Located a])
    forall a. Maybe a
    Nothing

      mkT :: Range -> a -> [Type a] -> Maybe (a, [Located a])
    mkT r :: Range
    r n :: a
    n ts :: [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)
    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 (f :: * -> *) a. Applicative f => a -> f a
    pure (a
    n,[Located a]
    ts1)

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

      -- inefficient, but the lists should be small
      distinct :: [a] -> Bool
    distinct xs :: [a]
    xs = case [a]
    xs of
                      [] -> Bool
    True
                      x :: a
    x : ys :: [a]
    ys -> Bool -> Bool
    not (a
    x 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 tp :: TParam n
    tp = case TParam n -> Maybe Kind
    forall n. TParam n -> Maybe Kind
    tpKind TParam n
    tp of
                 Just k :: Kind
    k  -> (n, (TParam n, Kind)) -> ParseM (n, (TParam n, Kind))
    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))
                 Nothing ->
                  case TParam n -> Maybe Range
    forall n. TParam n -> Maybe Range
    tpRange TParam n
    tp of
                    Just r :: Range
    r -> Range -> String -> ParseM (n, (TParam n, Kind))
    forall a. Range -> String -> ParseM a
    errorMessage Range
    r "Parameters need a kind annotation"
                    Nothing -> String -> [String] -> ParseM (n, (TParam n, Kind))
    forall a. HasCallStack => String -> [String] -> a
    panic "mkPrimTypeDecl"
                                  [ "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 String
    mkDoc :: Located Text -> Located String
    mkDoc ltxt :: Located Text
    ltxt = Located Text
    ltxt { thing :: String
    thing = String
    docStr }
      where

      docStr :: String
    docStr = [String] -> String
    unlines
             ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Text -> String) -> [Text] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> String
    T.unpack
             ([Text] -> [String]) -> [Text] -> [String]
    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 x :: Char
    x = Char
    x Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ("/* \r\n\t" :: String)

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

      trimFront :: [Text] -> [Text]
    trimFront []                     = []
      trimFront (l :: Text
    l:ls :: [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 [t :: Text
    t]       = [(Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    commentChar Text
    t]
      dropPrefix ts :: [Text]
    ts@(l :: Text
    l:ls :: [Text]
    ls) =
        case Text -> Maybe (Char, Text)
    T.uncons Text
    l of
          Just (c :: Char
    c,_) | 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 1) [Text]
    ts)
          _                                    -> [Text]
    ts

        where
        commonPrefix :: Char -> Text -> Bool
    commonPrefix c :: Char
    c t :: Text
    t =
          case Text -> Maybe (Char, Text)
    T.uncons Text
    t of
            Just (c' :: Char
    c',_) -> Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c'
            Nothing     -> Bool
    False

    distrLoc :: Located [a] -> [Located a]
    distrLoc :: Located [a] -> [Located a]
    distrLoc x :: Located [a]
    x = [ $WLocated :: forall a. Range -> a -> Located a
    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

    mkProp :: Type PName -> ParseM (Located [Prop PName])
    mkProp :: Type PName -> ParseM (Located [Prop PName])
    mkProp ty :: Type PName
    ty =
      case Type PName
    ty of
        TLocated t :: Type PName
    t r :: 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 (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
        _            -> String -> [String] -> ParseM (Located [Prop PName])
    forall a. HasCallStack => String -> [String] -> a
    panic "Parser" [ "Invalid type given to mkProp"
                                       , "expected a location"
                                       , Type PName -> String
    forall a. Show a => a -> String
    show Type PName
    ty ]

      where

      props :: Range -> Type n -> ParseM [Prop n]
    props r :: Range
    r t :: Type n
    t =
        case Type n
    t of
          TInfix{}       -> [Prop n] -> ParseM [Prop n]
    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 (m :: * -> *) a. Monad m => a -> m a
    return [Type n -> Prop n
    forall n. Type n -> Prop n
    CType Type n
    t]
          TTuple ts :: [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 (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)
    mapM (Range -> Type n -> ParseM [Prop n]
    props Range
    r) [Type n]
    ts
          TParens t' :: Type n
    t'     -> Range -> Type n -> ParseM [Prop n]
    props Range
    r  Type n
    t'
          TLocated t' :: Type n
    t' r' :: 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
          TWild     -> ParseM [Prop n]
    forall a. ParseM a
    err
          TRecord{} -> ParseM [Prop n]
    forall a. ParseM a
    err

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

    -- | Make an ordinary module
    mkModule :: Located ModName ->
                ([Located Import], [TopDecl PName]) ->
                Module PName
    mkModule :: Located ModName
    -> ([Located Import], [TopDecl PName]) -> Module PName
    mkModule nm :: Located ModName
    nm (is :: [Located Import]
    is,ds :: [TopDecl PName]
    ds) = $WModule :: forall name.
    Located ModName
    -> Maybe (Located ModName)
    -> [Located Import]
    -> [TopDecl name]
    -> Module name
    Module { mName :: Located ModName
    mName = Located ModName
    nm
                                 , mInstance :: Maybe (Located ModName)
    mInstance = Maybe (Located ModName)
    forall a. Maybe a
    Nothing
                                 , mImports :: [Located Import]
    mImports = [Located Import]
    is
                                 , mDecls :: [TopDecl PName]
    mDecls = [TopDecl PName]
    ds
                                 }

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

    -- | Make a module which defines a functor instance.
    mkModuleInstance :: Located ModName ->
                        Located ModName ->
                        ([Located Import], [TopDecl PName]) ->
                        Module PName
    mkModuleInstance :: Located ModName
    -> Located ModName
    -> ([Located Import], [TopDecl PName])
    -> Module PName
    mkModuleInstance nm :: Located ModName
    nm fun :: Located ModName
    fun (is :: [Located Import]
    is,ds :: [TopDecl PName]
    ds) =
      $WModule :: forall name.
    Located ModName
    -> Maybe (Located ModName)
    -> [Located Import]
    -> [TopDecl name]
    -> Module name
    Module { mName :: Located ModName
    mName     = Located ModName
    nm
             , mInstance :: Maybe (Located ModName)
    mInstance = Located ModName -> Maybe (Located ModName)
    forall a. a -> Maybe a
    Just Located ModName
    fun
             , mImports :: [Located Import]
    mImports  = [Located Import]
    is
             , mDecls :: [TopDecl PName]
    mDecls    = [TopDecl PName]
    ds
             }

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

    selExprToSels :: Expr PName -> ParseM [Located Selector]
    selExprToSels :: Expr PName -> ParseM [Located Selector]
    selExprToSels e0 :: 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 = String -> [String] -> a
    forall a. HasCallStack => String -> [String] -> a
    panic "selExprToSels" ["Missing location?"]
      go :: Range -> Expr PName -> ParseM [Located Selector]
    go loc :: Range
    loc expr :: Expr PName
    expr =
        case Expr PName
    expr of
          ELocated e1 :: Expr PName
    e1 r :: Range
    r -> Range -> Expr PName -> ParseM [Located Selector]
    go Range
    r Expr PName
    e1
          ESel e2 :: Expr PName
    e2 s :: 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. [a] -> a
    head [Located Selector]
    ls)) }
               [Located Selector] -> ParseM [Located Selector]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ($WLocated :: forall a. Range -> a -> Located a
    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 l :: Ident
    l) ->
            [Located Selector] -> ParseM [Located Selector]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ $WLocated :: forall a. Range -> a -> Located a
    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 n :: Integer
    n _) ->
            [Located Selector] -> ParseM [Located Selector]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [ $WLocated :: forall a. Range -> a -> Located a
    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 } ]
          _ -> Range -> String -> ParseM [Located Selector]
    forall a. Range -> String -> ParseM a
    errorMessage Range
    loc "Invalid label in record update."