{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE UndecidableInstances      #-}
{-# LANGUAGE TypeSynonymInstances      #-}
{-# LANGUAGE TupleSections             #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE DeriveDataTypeable        #-}

module Language.Haskell.Liquid.Parse
  ( hsSpecificationP
  , specSpecificationP
  , singleSpecP
  , BPspec
  , Pspec(..)
  , parseSymbolToLogic
  )
  where

import           Control.Arrow                          (second)
import           Control.Monad
import           Data.String
import           Prelude                                hiding (error)
import           Text.Parsec
import           Text.Parsec.Error                      (newErrorMessage, Message (..))
import           Text.Parsec.Pos

-- import           Text.Parsec.Char                       (newline) 
import qualified Text.Parsec.Token                      as Token
import qualified Data.Text                              as T
import qualified Data.HashMap.Strict                    as M
import qualified Data.HashSet                           as S
-- import           Data.Monoid
import           Data.Data
import qualified Data.Maybe                             as Mb -- (isNothing, fromMaybe)
import           Data.Char                              (isSpace, isAlpha, isUpper, isAlphaNum, isDigit)
import           Data.List                              (foldl', partition)
import           GHC                                    (ModuleName, mkModuleName)
import qualified Text.PrettyPrint.HughesPJ              as PJ 
import           Text.PrettyPrint.HughesPJ.Compat       ((<+>)) 
import           Language.Fixpoint.Types                hiding (panic, SVar, DDecl, DataDecl, DataCtor (..), Error, R, Predicate)
import           Language.Haskell.Liquid.GHC.Misc
import           Language.Haskell.Liquid.Types          
import qualified Language.Fixpoint.Misc                 as Misc      
import qualified Language.Haskell.Liquid.Misc           as Misc
import qualified Language.Haskell.Liquid.Measure        as Measure
import           Language.Fixpoint.Parse                hiding (stringLiteral, dataDeclP, angles, refBindP, refP, refDefP)

import Control.Monad.State

-- import Debug.Trace

--------------------------------------------------------------------------------
-- | Top Level Parsing API -----------------------------------------------------
--------------------------------------------------------------------------------

-- | Used to parse .hs and .lhs files (via ApiAnnotations)

-------------------------------------------------------------------------------
hsSpecificationP :: ModuleName
                 -> [(SourcePos, String)]
                 -> [BPspec]
                 -> Either [Error] (ModName, Measure.BareSpec)
-------------------------------------------------------------------------------
hsSpecificationP :: ModuleName
-> [(SourcePos, String)]
-> [BPspec]
-> Either [Error] (ModName, BareSpec)
hsSpecificationP ModuleName
modName [(SourcePos, String)]
specComments [BPspec]
specQuotes =
  case ([Error], [BPspec])
-> PState -> [(SourcePos, String)] -> ([Error], [BPspec])
go ([], []) PState
initPStateWithList ([(SourcePos, String)] -> ([Error], [BPspec]))
-> [(SourcePos, String)] -> ([Error], [BPspec])
forall a b. (a -> b) -> a -> b
$ [(SourcePos, String)] -> [(SourcePos, String)]
forall a. [a] -> [a]
reverse [(SourcePos, String)]
specComments of
    ([], [BPspec]
specs) ->
      (ModName, BareSpec) -> Either [Error] (ModName, BareSpec)
forall a b. b -> Either a b
Right ((ModName, BareSpec) -> Either [Error] (ModName, BareSpec))
-> (ModName, BareSpec) -> Either [Error] (ModName, BareSpec)
forall a b. (a -> b) -> a -> b
$ ModName -> [BPspec] -> (ModName, BareSpec)
mkSpec (ModType -> ModuleName -> ModName
ModName ModType
SrcImport ModuleName
modName) ([BPspec]
specs [BPspec] -> [BPspec] -> [BPspec]
forall a. [a] -> [a] -> [a]
++ [BPspec]
specQuotes)
    ([Error]
errs, [BPspec]
_) ->
      [Error] -> Either [Error] (ModName, BareSpec)
forall a b. a -> Either a b
Left [Error]
errs
  where
    go :: ([Error], [BPspec])   -- accumulated errors and parsed specs (in reverse order)
       -> PState                -- parser state (primarily infix operator priorities)
       -> [(SourcePos, String)] -- remaining unparsed spec comments
       -> ([Error], [BPspec])   -- final errors and parsed specs
    go :: ([Error], [BPspec])
-> PState -> [(SourcePos, String)] -> ([Error], [BPspec])
go ([Error]
errs, [BPspec]
specs) PState
_ []
      = ([Error] -> [Error]
forall a. [a] -> [a]
reverse [Error]
errs, [BPspec] -> [BPspec]
forall a. [a] -> [a]
reverse [BPspec]
specs)
    go ([Error]
errs, [BPspec]
specs) PState
pstate ((SourcePos
pos, String
specComment):[(SourcePos, String)]
xs)
      = -- 'specP' parses a single spec comment, i.e., a single LH directive
        case PState
-> Parser BPspec
-> SourcePos
-> String
-> Either Error (PState, BPspec)
forall a.
PState
-> Parser a -> SourcePos -> String -> Either Error (PState, a)
parseWithError PState
pstate Parser BPspec
specP SourcePos
pos String
specComment of
          Left Error
err        -> ([Error], [BPspec])
-> PState -> [(SourcePos, String)] -> ([Error], [BPspec])
go (Error
errError -> [Error] -> [Error]
forall a. a -> [a] -> [a]
:[Error]
errs, [BPspec]
specs) PState
pstate [(SourcePos, String)]
xs
          Right (PState
st,BPspec
spec) -> ([Error], [BPspec])
-> PState -> [(SourcePos, String)] -> ([Error], [BPspec])
go ([Error]
errs,BPspec
specBPspec -> [BPspec] -> [BPspec]
forall a. a -> [a] -> [a]
:[BPspec]
specs) PState
st [(SourcePos, String)]
xs

-- | Used to parse .spec files

initPStateWithList :: PState
initPStateWithList :: PState
initPStateWithList 
  = (Maybe Expr -> PState
initPState Maybe Expr
composeFun)
               { empList :: Maybe Expr
empList    = Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Symbol -> Expr
EVar (Symbol
"GHC.Types.[]" :: Symbol))
               , singList :: Maybe (Expr -> Expr)
singList   = (Expr -> Expr) -> Maybe (Expr -> Expr)
forall a. a -> Maybe a
Just (\Expr
e -> Expr -> Expr -> Expr
EApp (Expr -> Expr -> Expr
EApp (Symbol -> Expr
EVar (Symbol
"GHC.Types.:"  :: Symbol)) Expr
e) (Symbol -> Expr
EVar (Symbol
"GHC.Types.[]" :: Symbol)))
               }
  where composeFun :: Maybe Expr
composeFun = Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ Symbol -> Expr
EVar Symbol
functionComposisionSymbol

--------------------------------------------------------------------------
specSpecificationP  :: SourceName -> String -> Either Error (ModName, Measure.BareSpec)
--------------------------------------------------------------------------
specSpecificationP :: String -> String -> Either Error (ModName, BareSpec)
specSpecificationP String
f String
s = ((PState, (ModName, BareSpec)) -> (ModName, BareSpec))
-> Either Error (PState, (ModName, BareSpec))
-> Either Error (ModName, BareSpec)
forall a b l. (a -> b) -> Either l a -> Either l b
mapRight (PState, (ModName, BareSpec)) -> (ModName, BareSpec)
forall a b. (a, b) -> b
snd (Either Error (PState, (ModName, BareSpec))
 -> Either Error (ModName, BareSpec))
-> Either Error (PState, (ModName, BareSpec))
-> Either Error (ModName, BareSpec)
forall a b. (a -> b) -> a -> b
$  PState
-> Parser (ModName, BareSpec)
-> SourcePos
-> String
-> Either Error (PState, (ModName, BareSpec))
forall a.
PState
-> Parser a -> SourcePos -> String -> Either Error (PState, a)
parseWithError PState
initPStateWithList Parser (ModName, BareSpec)
specificationP (String -> Line -> Line -> SourcePos
newPos String
f Line
1 Line
1) String
s

specificationP :: Parser (ModName, Measure.BareSpec)
specificationP :: Parser (ModName, BareSpec)
specificationP = do 
  String -> Parser ()
reserved String
"module"
  String -> Parser ()
reserved String
"spec"
  Symbol
name   <- Parser Symbol
symbolP
  String -> Parser ()
reserved String
"where"
  [BPspec]
xs     <- if Bool
True then Parser BPspec -> ParsecT String Integer (State PState) [BPspec]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
grabs (Parser BPspec
specP Parser BPspec -> Parser () -> Parser BPspec
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whiteSpace) else Parser BPspec
-> ParsecT String Integer (State PState) Char
-> ParsecT String Integer (State PState) [BPspec]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy Parser BPspec
specP ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  (ModName, BareSpec) -> Parser (ModName, BareSpec)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ModName, BareSpec) -> Parser (ModName, BareSpec))
-> (ModName, BareSpec) -> Parser (ModName, BareSpec)
forall a b. (a -> b) -> a -> b
$ ModName -> [BPspec] -> (ModName, BareSpec)
mkSpec (ModType -> ModuleName -> ModName
ModName ModType
SpecImport (ModuleName -> ModName) -> ModuleName -> ModName
forall a b. (a -> b) -> a -> b
$ String -> ModuleName
mkModuleName (String -> ModuleName) -> String -> ModuleName
forall a b. (a -> b) -> a -> b
$ Symbol -> String
symbolString Symbol
name) [BPspec]
xs

-- debugP = grabs (specP <* whiteSpace)

-------------------------------------------------------------------------------
singleSpecP :: SourcePos -> String -> Either Error BPspec
-------------------------------------------------------------------------------
singleSpecP :: SourcePos -> String -> Either Error BPspec
singleSpecP SourcePos
pos = ((PState, BPspec) -> BPspec)
-> Either Error (PState, BPspec) -> Either Error BPspec
forall a b l. (a -> b) -> Either l a -> Either l b
mapRight (PState, BPspec) -> BPspec
forall a b. (a, b) -> b
snd (Either Error (PState, BPspec) -> Either Error BPspec)
-> (String -> Either Error (PState, BPspec))
-> String
-> Either Error BPspec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState
-> Parser BPspec
-> SourcePos
-> String
-> Either Error (PState, BPspec)
forall a.
PState
-> Parser a -> SourcePos -> String -> Either Error (PState, a)
parseWithError PState
initPStateWithList Parser BPspec
specP SourcePos
pos

mapRight :: (a -> b) -> Either l a -> Either l b
mapRight :: (a -> b) -> Either l a -> Either l b
mapRight a -> b
f (Right a
x) = b -> Either l b
forall a b. b -> Either a b
Right (b -> Either l b) -> b -> Either l b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
mapRight a -> b
_ (Left l
x)  = l -> Either l b
forall a b. a -> Either a b
Left l
x

---------------------------------------------------------------------------
parseWithError :: PState -> Parser a -> SourcePos -> String -> Either Error (PState, a)
---------------------------------------------------------------------------
parseWithError :: PState
-> Parser a -> SourcePos -> String -> Either Error (PState, a)
parseWithError PState
pstate Parser a
parser SourcePos
p String
s =
  case State PState (Either ParseError (a, String, SourcePos))
-> PState -> (Either ParseError (a, String, SourcePos), PState)
forall s a. State s a -> s -> (a, s)
runState (ParsecT String Integer (State PState) (a, String, SourcePos)
-> Integer
-> String
-> String
-> State PState (Either ParseError (a, String, SourcePos))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT ParsecT String Integer (State PState) (a, String, SourcePos)
doParse Integer
0 (SourcePos -> String
sourceName SourcePos
p) String
s) PState
pstate of
    (Left ParseError
e, PState
_)            -> Error -> Either Error (PState, a)
forall a b. a -> Either a b
Left  (Error -> Either Error (PState, a))
-> Error -> Either Error (PState, a)
forall a b. (a -> b) -> a -> b
$ ParseError -> Error
parseErrorError ParseError
e
    (Right (a
r, String
"", SourcePos
_), PState
st) -> (PState, a) -> Either Error (PState, a)
forall a b. b -> Either a b
Right (PState
st, a
r)
    (Right (a
_, String
rem, SourcePos
_), PState
_) -> Error -> Either Error (PState, a)
forall a b. a -> Either a b
Left  (Error -> Either Error (PState, a))
-> Error -> Either Error (PState, a)
forall a b. (a -> b) -> a -> b
$ ParseError -> Error
parseErrorError (ParseError -> Error) -> ParseError -> Error
forall a b. (a -> b) -> a -> b
$ SourcePos -> String -> String -> ParseError
remParseError SourcePos
p String
s String
rem
  where
    -- See http://stackoverflow.com/questions/16209278/parsec-consume-all-input
    doParse :: ParsecT String Integer (State PState) (a, String, SourcePos)
doParse = SourcePos -> Parser ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
p Parser ()
-> ParsecT String Integer (State PState) (a, String, SourcePos)
-> ParsecT String Integer (State PState) (a, String, SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
-> ParsecT String Integer (State PState) (a, String, SourcePos)
forall a. Parser a -> Parser (a, String, SourcePos)
remainderP (Parser ()
whiteSpace Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
parser Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ()
whiteSpace Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof))


---------------------------------------------------------------------------
parseErrorError     :: ParseError -> Error
---------------------------------------------------------------------------
parseErrorError :: ParseError -> Error
parseErrorError ParseError
e = SrcSpan -> Doc -> ParseError -> Error
forall t. SrcSpan -> Doc -> ParseError -> TError t
ErrParse SrcSpan
sp Doc
msg ParseError
e
  where
    pos :: SourcePos
pos             = ParseError -> SourcePos
errorPos ParseError
e
    sp :: SrcSpan
sp              = SourcePos -> SrcSpan
sourcePosSrcSpan SourcePos
pos
    msg :: Doc
msg             = Doc
"Error Parsing Specification from:" Doc -> Doc -> Doc
<+> String -> Doc
PJ.text (SourcePos -> String
sourceName SourcePos
pos)

---------------------------------------------------------------------------
remParseError       :: SourcePos -> String -> String -> ParseError
---------------------------------------------------------------------------
remParseError :: SourcePos -> String -> String -> ParseError
remParseError SourcePos
p String
s String
r = Message -> SourcePos -> ParseError
newErrorMessage Message
msg (SourcePos -> ParseError) -> SourcePos -> ParseError
forall a b. (a -> b) -> a -> b
$ String -> Line -> Line -> SourcePos
newPos (SourcePos -> String
sourceName SourcePos
p) Line
line Line
col
  where
    msg :: Message
msg             = String -> Message
Message String
"Leftover while parsing"
    (Line
line, Line
col)     = SourcePos -> String -> String -> (Line, Line)
remLineCol SourcePos
p String
s String
r

remLineCol             :: SourcePos -> String -> String -> (Int, Int)
remLineCol :: SourcePos -> String -> String -> (Line, Line)
remLineCol SourcePos
pos String
src String
rem = (Line
line Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
offLine, Line
col Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
offCol)
  where
    line :: Line
line               = Line
1 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
srcLine Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
remLine
    srcLine :: Line
srcLine            = [String] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length [String]
srcLines
    remLine :: Line
remLine            = [String] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length [String]
remLines
    offLine :: Line
offLine            = SourcePos -> Line
sourceLine SourcePos
pos Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1
    col :: Line
col                = Line
1 Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
srcCol Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
remCol
    srcCol :: Line
srcCol             = String -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length (String -> Line) -> String -> Line
forall a b. (a -> b) -> a -> b
$ [String]
srcLines [String] -> Line -> String
forall a. [a] -> Line -> a
!! (Line
line Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1)
    remCol :: Line
remCol             = String -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length (String -> Line) -> String -> Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
remLines
    offCol :: Line
offCol             = if Line
line Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== Line
1 then SourcePos -> Line
sourceColumn SourcePos
pos Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1 else Line
0
    srcLines :: [String]
srcLines           = String -> [String]
lines  String
src
    remLines :: [String]
remLines           = String -> [String]
lines  String
rem



--------------------------------------------------------------------------------
-- Parse to Logic  -------------------------------------------------------------
--------------------------------------------------------------------------------

parseSymbolToLogic :: SourceName -> String -> Either Error LogicMap
parseSymbolToLogic :: String -> String -> Either Error LogicMap
parseSymbolToLogic String
f = ((PState, LogicMap) -> LogicMap)
-> Either Error (PState, LogicMap) -> Either Error LogicMap
forall a b l. (a -> b) -> Either l a -> Either l b
mapRight (PState, LogicMap) -> LogicMap
forall a b. (a, b) -> b
snd (Either Error (PState, LogicMap) -> Either Error LogicMap)
-> (String -> Either Error (PState, LogicMap))
-> String
-> Either Error LogicMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PState
-> Parser LogicMap
-> SourcePos
-> String
-> Either Error (PState, LogicMap)
forall a.
PState
-> Parser a -> SourcePos -> String -> Either Error (PState, a)
parseWithError PState
initPStateWithList Parser LogicMap
toLogicP (String -> Line -> Line -> SourcePos
newPos String
f Line
1 Line
1)

toLogicP :: Parser LogicMap
toLogicP :: Parser LogicMap
toLogicP
  = [(LocSymbol, [Symbol], Expr)] -> LogicMap
toLogicMap ([(LocSymbol, [Symbol], Expr)] -> LogicMap)
-> ParsecT
     String Integer (State PState) [(LocSymbol, [Symbol], Expr)]
-> Parser LogicMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) (LocSymbol, [Symbol], Expr)
-> ParsecT
     String Integer (State PState) [(LocSymbol, [Symbol], Expr)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String Integer (State PState) (LocSymbol, [Symbol], Expr)
toLogicOneP

toLogicOneP :: Parser  (LocSymbol, [Symbol], Expr)
toLogicOneP :: ParsecT String Integer (State PState) (LocSymbol, [Symbol], Expr)
toLogicOneP
  = do String -> Parser ()
reserved String
"define"
       (LocSymbol
x:[LocSymbol]
xs) <- ParsecT String Integer (State PState) LocSymbol
-> ParsecT String Integer (State PState) [LocSymbol]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
symbolP)
       String -> Parser ()
reservedOp String
"="
       Expr
e      <- Parser Expr
exprP
       (LocSymbol, [Symbol], Expr)
-> ParsecT
     String Integer (State PState) (LocSymbol, [Symbol], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocSymbol
x, LocSymbol -> Symbol
forall a. Located a -> a
val (LocSymbol -> Symbol) -> [LocSymbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocSymbol]
xs, Expr
e)


defineP :: Parser (LocSymbol, Symbol)
defineP :: Parser (LocSymbol, Symbol)
defineP = do LocSymbol
v <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP
             Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
             String -> Parser ()
reservedOp String
"="
             Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
             Symbol
x <- Parser Symbol
binderP
             (LocSymbol, Symbol) -> Parser (LocSymbol, Symbol)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocSymbol
v, Symbol
x)

--------------------------------------------------------------------------------
-- Lexer Tokens ----------------------------------------------------------------
--------------------------------------------------------------------------------

dot :: Parser String
dot :: Parser String
dot = GenTokenParser String Integer (State PState) -> Parser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
Token.dot GenTokenParser String Integer (State PState)
forall (m :: * -> *) u. Monad m => GenTokenParser String u m
lexer

angles :: Parser a -> Parser a
angles :: Parser a -> Parser a
angles = GenTokenParser String Integer (State PState)
-> forall a.
   ParsecT String Integer (State PState) a
   -> ParsecT String Integer (State PState) a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
Token.angles GenTokenParser String Integer (State PState)
forall (m :: * -> *) u. Monad m => GenTokenParser String u m
lexer

stringLiteral :: Parser String
stringLiteral :: Parser String
stringLiteral = GenTokenParser String Integer (State PState) -> Parser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
Token.stringLiteral GenTokenParser String Integer (State PState)
forall (m :: * -> *) u. Monad m => GenTokenParser String u m
lexer

--------------------------------------------------------------------------------
-- | BareTypes -----------------------------------------------------------------
--------------------------------------------------------------------------------

{- | [NOTE:BARETYPE-PARSE] Fundamentally, a type is of the form

      comp -> comp -> ... -> comp

So

  bt = comp
     | comp '->' bt

  comp = circle
       | '(' bt ')'

  circle = the ground component of a baretype, sans parens or "->" at the top level

Each 'comp' should have a variable to refer to it,
either a parser-assigned one or given explicitly. e.g.

  xs : [Int]

-}

data ParamComp = PC { ParamComp -> PcScope
_pci :: PcScope
                    , ParamComp -> BareType
_pct :: BareType }
                    deriving (Line -> ParamComp -> ShowS
[ParamComp] -> ShowS
ParamComp -> String
(Line -> ParamComp -> ShowS)
-> (ParamComp -> String)
-> ([ParamComp] -> ShowS)
-> Show ParamComp
forall a.
(Line -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamComp] -> ShowS
$cshowList :: [ParamComp] -> ShowS
show :: ParamComp -> String
$cshow :: ParamComp -> String
showsPrec :: Line -> ParamComp -> ShowS
$cshowsPrec :: Line -> ParamComp -> ShowS
Show)

data PcScope = PcImplicit Symbol
             | PcExplicit Symbol
             | PcNoSymbol
             deriving (PcScope -> PcScope -> Bool
(PcScope -> PcScope -> Bool)
-> (PcScope -> PcScope -> Bool) -> Eq PcScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PcScope -> PcScope -> Bool
$c/= :: PcScope -> PcScope -> Bool
== :: PcScope -> PcScope -> Bool
$c== :: PcScope -> PcScope -> Bool
Eq,Line -> PcScope -> ShowS
[PcScope] -> ShowS
PcScope -> String
(Line -> PcScope -> ShowS)
-> (PcScope -> String) -> ([PcScope] -> ShowS) -> Show PcScope
forall a.
(Line -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PcScope] -> ShowS
$cshowList :: [PcScope] -> ShowS
show :: PcScope -> String
$cshow :: PcScope -> String
showsPrec :: Line -> PcScope -> ShowS
$cshowsPrec :: Line -> PcScope -> ShowS
Show)

nullPC :: BareType -> ParamComp
nullPC :: BareType -> ParamComp
nullPC BareType
bt = PcScope -> BareType -> ParamComp
PC PcScope
PcNoSymbol BareType
bt

btP :: Parser ParamComp
btP :: Parser ParamComp
btP = do
  c :: ParamComp
c@(PC PcScope
sb BareType
_) <- Parser ParamComp
compP
  case PcScope
sb of
    PcScope
PcNoSymbol   -> ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return ParamComp
c
    PcImplicit Symbol
b -> ParamComp -> Symbol -> Parser ParamComp
parseFun ParamComp
c Symbol
b
    PcExplicit Symbol
b -> ParamComp -> Symbol -> Parser ParamComp
parseFun ParamComp
c Symbol
b
  Parser ParamComp -> String -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"btP"
  where
    parseFun :: ParamComp -> Symbol -> Parser ParamComp
parseFun c :: ParamComp
c@(PC PcScope
sb BareType
t1) Symbol
b  =
      ((do
            String -> Parser ()
reservedOp String
"->"
            PC PcScope
_ BareType
t2 <- Parser ParamComp
btP
            ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return (PcScope -> BareType -> ParamComp
PC PcScope
sb (Symbol -> BareType -> BareType -> BareType
forall r c tv.
Monoid r =>
Symbol -> RType c tv r -> RType c tv r -> RType c tv r
rFun Symbol
b BareType
t1 BareType
t2)))
        Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
         (do
            String -> Parser ()
reservedOp String
"~>"
            PC PcScope
_ BareType
t2 <- Parser ParamComp
btP
            ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return (PcScope -> BareType -> ParamComp
PC PcScope
sb (Symbol -> BareType -> BareType -> BareType
forall r c tv.
Monoid r =>
Symbol -> RType c tv r -> RType c tv r -> RType c tv r
rImpF Symbol
b BareType
t1 BareType
t2)))
        Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
         (do
            String -> Parser ()
reservedOp String
"=>"
            PC PcScope
_ BareType
t2 <- Parser ParamComp
btP
            -- TODO:AZ return an error if s == PcExplicit
            ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamComp -> Parser ParamComp) -> ParamComp -> Parser ParamComp
forall a b. (a -> b) -> a -> b
$ PcScope -> BareType -> ParamComp
PC PcScope
sb (BareType -> ParamComp) -> BareType -> ParamComp
forall a b. (a -> b) -> a -> b
$ (BareType -> BareType -> BareType)
-> BareType -> [BareType] -> BareType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Symbol -> BareType -> BareType -> BareType
forall r c tv.
Monoid r =>
Symbol -> RType c tv r -> RType c tv r -> RType c tv r
rFun Symbol
dummySymbol) BareType
t2 (BareType -> [BareType]
forall t t1. RType BTyCon t t1 -> [RType BTyCon t t1]
getClasses BareType
t1))
         Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 
          (do 
             Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces 
             LocSymbol
b <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
infixSymbolP
             Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
             PC PcScope
_ BareType
t2 <- Parser ParamComp
btP 
             ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamComp -> Parser ParamComp) -> ParamComp -> Parser ParamComp
forall a b. (a -> b) -> a -> b
$ PcScope -> BareType -> ParamComp
PC PcScope
sb (BareType -> ParamComp) -> BareType -> ParamComp
forall a b. (a -> b) -> a -> b
$ (BTyCon
-> [BareType] -> [RTProp BTyCon BTyVar RReft] -> RReft -> BareType
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp (LocSymbol -> BTyCon
mkBTyCon LocSymbol
b) [BareType
t1,BareType
t2] [] RReft
forall a. Monoid a => a
mempty))
         Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return ParamComp
c)


compP :: Parser ParamComp
compP :: Parser ParamComp
compP = Parser ParamComp
circleP Parser ParamComp -> Parser () -> Parser ParamComp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
whiteSpace Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ParamComp -> Parser ParamComp
forall u a. ParserT u a -> ParserT u a
parens Parser ParamComp
btP Parser ParamComp -> String -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"compP"

circleP :: Parser ParamComp
circleP :: Parser ParamComp
circleP
  =  BareType -> ParamComp
nullPC (BareType -> ParamComp)
-> ParsecT String Integer (State PState) BareType
-> Parser ParamComp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Parser ()
reserved String
"forall" Parser ()
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String Integer (State PState) BareType
bareAllP)
 Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ParamComp
holePC                                 -- starts with '_'
 Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ParamComp
namedCircleP                           -- starts with lower
 Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ParamComp
bareTypeBracesP                        -- starts with '{'
 Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ParamComp
unnamedCircleP
 Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ParamComp
anglesCircleP                          -- starts with '<'
 Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> BareType -> ParamComp
nullPC (BareType -> ParamComp)
-> ParsecT String Integer (State PState) BareType
-> Parser ParamComp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) b. Monad m => m (Reft -> b) -> m b
dummyP (ParsecT String Integer (State PState) (Reft -> BareType)
bbaseP ParsecT String Integer (State PState) (Reft -> BareType)
-> Parser ()
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)) -- starts with '_' or '[' or '(' or lower or "'" or upper
 Parser ParamComp -> String -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"circleP"

anglesCircleP :: Parser ParamComp
anglesCircleP :: Parser ParamComp
anglesCircleP
  = Parser ParamComp -> Parser ParamComp
forall a.
ParsecT String Integer (State PState) a
-> ParsecT String Integer (State PState) a
angles (Parser ParamComp -> Parser ParamComp)
-> Parser ParamComp -> Parser ParamComp
forall a b. (a -> b) -> a -> b
$ do
      PC PcScope
sb BareType
t <- Parser ParamComp -> Parser ParamComp
forall u a. ParserT u a -> ParserT u a
parens Parser ParamComp
btP
      Predicate
p       <- Parser Predicate
monoPredicateP
      ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return   (ParamComp -> Parser ParamComp) -> ParamComp -> Parser ParamComp
forall a b. (a -> b) -> a -> b
$ PcScope -> BareType -> ParamComp
PC PcScope
sb (BareType
t BareType -> RReft -> BareType
forall r c tv. Reftable r => RType c tv r -> r -> RType c tv r
`strengthen` Reft -> Predicate -> RReft
forall r. r -> Predicate -> UReft r
MkUReft Reft
forall a. Monoid a => a
mempty Predicate
p)

holePC :: Parser ParamComp
holePC :: Parser ParamComp
holePC = do
  BareType
h <- ParsecT String Integer (State PState) BareType
holeP
  Symbol
b <- Parser Symbol
dummyBindP
  ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return (PcScope -> BareType -> ParamComp
PC (Symbol -> PcScope
PcImplicit Symbol
b) BareType
h)

namedCircleP :: Parser ParamComp
namedCircleP :: Parser ParamComp
namedCircleP = do
  LocSymbol
lb <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
lowerIdP
  (do String
_ <- Parser String
colon
      let b :: Symbol
b = LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lb
      PcScope -> BareType -> ParamComp
PC (Symbol -> PcScope
PcExplicit Symbol
b) (BareType -> ParamComp)
-> ParsecT String Integer (State PState) BareType
-> Parser ParamComp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> ParsecT String Integer (State PState) BareType
bareArgP Symbol
b
    Parser ParamComp -> Parser ParamComp -> Parser ParamComp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do
      Symbol
b <- Parser Symbol
dummyBindP
      PcScope -> BareType -> ParamComp
PC (Symbol -> PcScope
PcImplicit Symbol
b) (BareType -> ParamComp)
-> ParsecT String Integer (State PState) BareType
-> Parser ParamComp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) b. Monad m => m (Reft -> b) -> m b
dummyP (Symbol -> ParsecT String Integer (State PState) (Reft -> BareType)
lowerIdTail (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lb))
    )

unnamedCircleP :: Parser ParamComp
unnamedCircleP :: Parser ParamComp
unnamedCircleP = do
  LocSymbol
lb <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
dummyBindP
  let b :: Symbol
b = LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lb
  BareType
t1 <- Symbol -> ParsecT String Integer (State PState) BareType
bareArgP Symbol
b
  ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamComp -> Parser ParamComp) -> ParamComp -> Parser ParamComp
forall a b. (a -> b) -> a -> b
$ PcScope -> BareType -> ParamComp
PC (Symbol -> PcScope
PcImplicit Symbol
b) BareType
t1

-- ---------------------------------------------------------------------

-- | The top-level parser for "bare" refinement types. If refinements are
-- not supplied, then the default "top" refinement is used.

bareTypeP :: Parser BareType
bareTypeP :: ParsecT String Integer (State PState) BareType
bareTypeP = do
  PC PcScope
_ BareType
v <- Parser ParamComp
btP
  BareType -> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) a. Monad m => a -> m a
return BareType
v

bareTypeBracesP :: Parser ParamComp
bareTypeBracesP :: Parser ParamComp
bareTypeBracesP = do
  Either ParamComp BareType
t <-  ParsecT String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall u a. ParserT u a -> ParserT u a
braces (
            (ParsecT String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
               BareType
ct <- ParsecT String Integer (State PState) BareType
constraintP
               Either ParamComp BareType
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParamComp BareType
 -> ParsecT
      String Integer (State PState) (Either ParamComp BareType))
-> Either ParamComp BareType
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall a b. (a -> b) -> a -> b
$ BareType -> Either ParamComp BareType
forall a b. b -> Either a b
Right BareType
ct
                     ))
           ParsecT String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
            (do
                    Symbol
x  <- Parser Symbol
symbolP
                    String
_ <- Parser String
colon
                    -- NOSUBST i  <- freshIntP
                    Reft -> BareType
t  <- ParsecT String Integer (State PState) (Reft -> BareType)
bbaseP
                    String -> Parser ()
reservedOp String
"|"
                    Expr
ra <- Parser Expr
refasHoleP Parser Expr -> Parser () -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                    -- xi is a unique var based on the name in x.
                    -- su replaces any use of x in the balance of the expression with the unique val
                    -- NOSUBST let xi = intSymbol x i
                    -- NOSUBST let su v = if v == x then xi else v
                    Either ParamComp BareType
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParamComp BareType
 -> ParsecT
      String Integer (State PState) (Either ParamComp BareType))
-> Either ParamComp BareType
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall a b. (a -> b) -> a -> b
$ ParamComp -> Either ParamComp BareType
forall a b. a -> Either a b
Left (ParamComp -> Either ParamComp BareType)
-> ParamComp -> Either ParamComp BareType
forall a b. (a -> b) -> a -> b
$ PcScope -> BareType -> ParamComp
PC (Symbol -> PcScope
PcExplicit Symbol
x) (BareType -> ParamComp) -> BareType -> ParamComp
forall a b. (a -> b) -> a -> b
$ Reft -> BareType
t ((Symbol, Expr) -> Reft
Reft (Symbol
x, Expr
ra)) )
            )) ParsecT String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser Expr
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall u b.
ParsecT String u (State PState) Expr
-> ParserT u (Either ParamComp b)
helper Parser Expr
holeOrPredsP) ParsecT String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr
-> ParsecT
     String Integer (State PState) (Either ParamComp BareType)
forall u b.
ParsecT String u (State PState) Expr
-> ParserT u (Either ParamComp b)
helper Parser Expr
predP
  case Either ParamComp BareType
t of
    Left ParamComp
l -> ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return ParamComp
l
    Right BareType
ct -> do
      PC PcScope
_sb BareType
tt <- Parser ParamComp
btP
      ParamComp -> Parser ParamComp
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamComp -> Parser ParamComp) -> ParamComp -> Parser ParamComp
forall a b. (a -> b) -> a -> b
$ BareType -> ParamComp
nullPC (BareType -> ParamComp) -> BareType -> ParamComp
forall a b. (a -> b) -> a -> b
$ BareType -> BareType -> BareType
forall r c tv.
Monoid r =>
RType c tv r -> RType c tv r -> RType c tv r
rrTy BareType
ct BareType
tt
  where
    holeOrPredsP :: Parser Expr
holeOrPredsP
      = (String -> Parser ()
reserved String
"_" Parser () -> Parser Expr -> Parser Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Parser Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
hole)
     Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ListNE Expr -> Expr
pAnd (ListNE Expr -> Expr)
-> ParsecT String Integer (State PState) (ListNE Expr)
-> Parser Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) (ListNE Expr)
-> ParsecT String Integer (State PState) (ListNE Expr)
forall u a. ParserT u a -> ParserT u a
brackets (Parser Expr
-> Parser String
-> ParsecT String Integer (State PState) (ListNE Expr)
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy Parser Expr
predP Parser String
semi))
    helper :: ParsecT String u (State PState) Expr
-> ParserT u (Either ParamComp b)
helper ParsecT String u (State PState) Expr
p = ParserT u (Either ParamComp b) -> ParserT u (Either ParamComp b)
forall u a. ParserT u a -> ParserT u a
braces (ParserT u (Either ParamComp b) -> ParserT u (Either ParamComp b))
-> ParserT u (Either ParamComp b) -> ParserT u (Either ParamComp b)
forall a b. (a -> b) -> a -> b
$ do
      BareType
t <- ((RReft -> BareType
forall c tv r. r -> RType c tv r
RHole (RReft -> BareType) -> (Expr -> RReft) -> Expr -> BareType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reft -> RReft
forall r. r -> UReft r
uTop (Reft -> RReft) -> (Expr -> Reft) -> Expr -> RReft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol, Expr) -> Reft
Reft ((Symbol, Expr) -> Reft)
-> (Expr -> (Symbol, Expr)) -> Expr -> Reft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol
"VV",)) (Expr -> BareType)
-> ParsecT String u (State PState) Expr
-> ParsecT String u (State PState) BareType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String u (State PState) Expr
p ParsecT String u (State PState) Expr
-> ParsecT String u (State PState) ()
-> ParsecT String u (State PState) Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String u (State PState) ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))
      Either ParamComp b -> ParserT u (Either ParamComp b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParamComp -> Either ParamComp b
forall a b. a -> Either a b
Left (ParamComp -> Either ParamComp b)
-> ParamComp -> Either ParamComp b
forall a b. (a -> b) -> a -> b
$ BareType -> ParamComp
nullPC BareType
t)


bareArgP :: Symbol -> Parser BareType
bareArgP :: Symbol -> ParsecT String Integer (State PState) BareType
bareArgP Symbol
vvv
  =  Symbol
-> Parser Expr
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
refDefP Symbol
vvv Parser Expr
refasHoleP ParsecT String Integer (State PState) (Reft -> BareType)
bbaseP    -- starts with '{'
 ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) BareType
holeP                            -- starts with '_'
 ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) b. Monad m => m (Reft -> b) -> m b
dummyP (ParsecT String Integer (State PState) (Reft -> BareType)
bbaseP ParsecT String Integer (State PState) (Reft -> BareType)
-> Parser ()
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))
 ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall u a. ParserT u a -> ParserT u a
parens ParsecT String Integer (State PState) BareType
bareTypeP                 -- starts with '('
                                      -- starts with '_', '[', '(', lower, upper
 ParsecT String Integer (State PState) BareType
-> String -> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"bareArgP"

bareAtomP :: (Parser Expr -> Parser (Reft -> BareType) -> Parser BareType)
          -> Parser BareType
bareAtomP :: (Parser Expr
 -> ParsecT String Integer (State PState) (Reft -> BareType)
 -> ParsecT String Integer (State PState) BareType)
-> ParsecT String Integer (State PState) BareType
bareAtomP Parser Expr
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
ref
  =  Parser Expr
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
ref Parser Expr
refasHoleP ParsecT String Integer (State PState) (Reft -> BareType)
bbaseP
 ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) BareType
holeP
 ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) b. Monad m => m (Reft -> b) -> m b
dummyP (ParsecT String Integer (State PState) (Reft -> BareType)
bbaseP ParsecT String Integer (State PState) (Reft -> BareType)
-> Parser ()
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))
 ParsecT String Integer (State PState) BareType
-> String -> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"bareAtomP"

bareAtomBindP :: Parser BareType
bareAtomBindP :: ParsecT String Integer (State PState) BareType
bareAtomBindP = (Parser Expr
 -> ParsecT String Integer (State PState) (Reft -> BareType)
 -> ParsecT String Integer (State PState) BareType)
-> ParsecT String Integer (State PState) BareType
bareAtomP Parser Expr
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
refBindBindP


-- Either
--  { x : t | ra }
-- or
--  { ra }
refBindBindP :: Parser Expr
             -> Parser (Reft -> BareType)
             -> Parser BareType
refBindBindP :: Parser Expr
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
refBindBindP Parser Expr
rp ParsecT String Integer (State PState) (Reft -> BareType)
kindP'
  = ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall u a. ParserT u a -> ParserT u a
braces (
      ((do
              Symbol
x  <- Parser Symbol
symbolP
              String
_ <- Parser String
colon
              -- NOSUBST i  <- freshIntP
              Reft -> BareType
t  <- ParsecT String Integer (State PState) (Reft -> BareType)
kindP'
              String -> Parser ()
reservedOp String
"|"
              Expr
ra <- Parser Expr
rp Parser Expr -> Parser () -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
              -- xi is a unique var based on the name in x.
              -- su replaces any use of x in the balance of the expression with the unique val
              -- NOSUBST let xi = intSymbol x i
              -- NOSUBST let su v = if v == x then xi else v
              BareType -> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) a. Monad m => a -> m a
return (BareType -> ParsecT String Integer (State PState) BareType)
-> BareType -> ParsecT String Integer (State PState) BareType
forall a b. (a -> b) -> a -> b
$ {- substa su $ NOSUBST -} Reft -> BareType
t ((Symbol, Expr) -> Reft
Reft (Symbol
x, Expr
ra)) ))
     ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((RReft -> BareType
forall c tv r. r -> RType c tv r
RHole (RReft -> BareType) -> (Expr -> RReft) -> Expr -> BareType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reft -> RReft
forall r. r -> UReft r
uTop (Reft -> RReft) -> (Expr -> Reft) -> Expr -> RReft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol, Expr) -> Reft
Reft ((Symbol, Expr) -> Reft)
-> (Expr -> (Symbol, Expr)) -> Expr -> Reft
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol
"VV",)) (Expr -> BareType)
-> Parser Expr -> ParsecT String Integer (State PState) BareType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Expr
rp Parser Expr -> Parser () -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces))
     ParsecT String Integer (State PState) BareType
-> String -> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"refBindBindP"
   )


refDefP :: Symbol
        -> Parser Expr
        -> Parser (Reft -> BareType)
        -> Parser BareType
refDefP :: Symbol
-> Parser Expr
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
refDefP Symbol
vv Parser Expr
rp ParsecT String Integer (State PState) (Reft -> BareType)
kindP' = ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall u a. ParserT u a -> ParserT u a
braces (ParsecT String Integer (State PState) BareType
 -> ParsecT String Integer (State PState) BareType)
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall a b. (a -> b) -> a -> b
$ do
  Symbol
x       <- Symbol -> Parser Symbol
optBindP Symbol
vv
  -- NOSUBST i       <- freshIntP
  Reft -> BareType
t       <- ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String Integer (State PState) (Reft -> BareType)
kindP' ParsecT String Integer (State PState) (Reft -> BareType)
-> Parser ()
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
reservedOp String
"|") ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a. Monad m => a -> m a
return (RReft -> BareType
forall c tv r. r -> RType c tv r
RHole (RReft -> BareType) -> (Reft -> RReft) -> Reft -> BareType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reft -> RReft
forall r. r -> UReft r
uTop) ParsecT String Integer (State PState) (Reft -> BareType)
-> String
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"refDefP"
  Expr
ra      <- (Parser Expr
rp Parser Expr -> Parser () -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)
  -- xi is a unique var based on the name in x.
  -- su replaces any use of x in the balance of the expression with the unique val
  -- NOSUBST let xi   = intSymbol x i
  -- NOSUBST let su v = if v == x then xi else v
  BareType -> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) a. Monad m => a -> m a
return   (BareType -> ParsecT String Integer (State PState) BareType)
-> BareType -> ParsecT String Integer (State PState) BareType
forall a b. (a -> b) -> a -> b
$ {- substa su $ NOSUBST -} Reft -> BareType
t ((Symbol, Expr) -> Reft
Reft (Symbol
x, Expr
ra))
       -- substa su . t . Reft . (x,) <$> (rp <* spaces))
      --  <|> ((RHole . uTop . Reft . ("VV",)) <$> (rp <* spaces))

refP :: Parser (Reft -> BareType) -> Parser BareType
refP :: ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
refP = Parser Expr
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
refBindBindP Parser Expr
refaP

-- "sym :" or return the devault sym
optBindP :: Symbol -> Parser Symbol
optBindP :: Symbol -> Parser Symbol
optBindP Symbol
x = Parser Symbol -> Parser Symbol
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Symbol
bindP Parser Symbol -> Parser Symbol -> Parser Symbol
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Symbol -> Parser Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
x

holeP :: Parser BareType
holeP :: ParsecT String Integer (State PState) BareType
holeP    = String -> Parser ()
reserved String
"_" Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces Parser ()
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BareType -> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) a. Monad m => a -> m a
return (RReft -> BareType
forall c tv r. r -> RType c tv r
RHole (RReft -> BareType) -> RReft -> BareType
forall a b. (a -> b) -> a -> b
$ Reft -> RReft
forall r. r -> UReft r
uTop (Reft -> RReft) -> Reft -> RReft
forall a b. (a -> b) -> a -> b
$ (Symbol, Expr) -> Reft
Reft (Symbol
"VV", Expr
hole))

holeRefP :: Parser (Reft -> BareType)
holeRefP :: ParsecT String Integer (State PState) (Reft -> BareType)
holeRefP = String -> Parser ()
reserved String
"_" Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces Parser ()
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a. Monad m => a -> m a
return (RReft -> BareType
forall c tv r. r -> RType c tv r
RHole (RReft -> BareType) -> (Reft -> RReft) -> Reft -> BareType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reft -> RReft
forall r. r -> UReft r
uTop)

-- NOPROP refasHoleP :: Parser Expr
-- NOPROP refasHoleP  = try refaP
-- NOPROP          <|> (reserved "_" >> return hole)

refasHoleP :: Parser Expr
refasHoleP :: Parser Expr
refasHoleP
  =  (String -> Parser ()
reserved String
"_" Parser () -> Parser Expr -> Parser Expr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr -> Parser Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
hole)
 Parser Expr -> Parser Expr -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Expr
refaP
 Parser Expr -> String -> Parser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"refasHoleP"

-- FIXME: the use of `blanks = oneOf " \t"` here is a terrible and fragile hack
-- to avoid parsing:
--
--   foo :: a -> b
--   bar :: a
--
-- as `foo :: a -> b bar`..
bbaseP :: Parser (Reft -> BareType)
bbaseP :: ParsecT String Integer (State PState) (Reft -> BareType)
bbaseP
  =  ParsecT String Integer (State PState) (Reft -> BareType)
holeRefP  -- Starts with '_'
 ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Maybe BareType
 -> [RTProp BTyCon BTyVar RReft] -> Reft -> BareType)
-> ParsecT String Integer (State PState) (Maybe BareType)
-> ParsecT
     String Integer (State PState) [RTProp BTyCon BTyVar RReft]
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe BareType -> [RTProp BTyCon BTyVar RReft] -> Reft -> BareType
forall tv r.
Maybe (RType BTyCon tv (UReft r))
-> [RTProp BTyCon tv (UReft r)] -> r -> RType BTyCon tv (UReft r)
bLst (ParsecT String Integer (State PState) (Maybe BareType)
-> ParsecT String Integer (State PState) (Maybe BareType)
forall u a. ParserT u a -> ParserT u a
brackets (ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Maybe BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeP ParsecT String Integer (State PState) BareType
bareTypeP)) ParsecT String Integer (State PState) [RTProp BTyCon BTyVar RReft]
forall tv r c.
(IsString tv, Monoid r) =>
Parser [Ref (RType c tv r) BareType]
predicatesP
 ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([(Maybe Symbol, BareType)]
 -> [RTProp BTyCon BTyVar RReft] -> Reft -> BareType)
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
-> ParsecT
     String Integer (State PState) [RTProp BTyCon BTyVar RReft]
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [(Maybe Symbol, BareType)]
-> [RTProp BTyCon BTyVar RReft] -> Reft -> BareType
forall r.
(PPrint r, Reftable r, Reftable (RType BTyCon BTyVar (UReft r)),
 Reftable (RTProp BTyCon BTyVar (UReft r))) =>
[(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
-> [RTProp BTyCon BTyVar (UReft r)]
-> r
-> RType BTyCon BTyVar (UReft r)
bTup (ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
forall u a. ParserT u a -> ParserT u a
parens (ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
 -> ParsecT
      String Integer (State PState) [(Maybe Symbol, BareType)])
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
forall a b. (a -> b) -> a -> b
$ ParsecT String Integer (State PState) (Maybe Symbol, BareType)
-> Parser String
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Maybe Symbol, BareType)
forall a. Parser a -> Parser (Maybe Symbol, a)
maybeBind ParsecT String Integer (State PState) BareType
bareTypeP) Parser String
comma) ParsecT String Integer (State PState) [RTProp BTyCon BTyVar RReft]
forall tv r c.
(IsString tv, Monoid r) =>
Parser [Ref (RType c tv r) BareType]
predicatesP
 ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String Integer (State PState) (Reft -> BareType)
parseHelper  -- starts with lower
 ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (BTyCon
 -> [RTProp BTyCon BTyVar RReft]
 -> [BareType]
 -> Predicate
 -> Reft
 -> BareType)
-> ParsecT String Integer (State PState) BTyCon
-> ParsecT
     String Integer (State PState) [RTProp BTyCon BTyVar RReft]
-> ParsecT String Integer (State PState) [BareType]
-> Parser Predicate
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 BTyCon
-> [RTProp BTyCon BTyVar RReft]
-> [BareType]
-> Predicate
-> Reft
-> BareType
forall c tv r.
c
-> [RTProp c tv (UReft r)]
-> [RType c tv (UReft r)]
-> Predicate
-> r
-> RType c tv (UReft r)
bCon ParsecT String Integer (State PState) BTyCon
bTyConP ParsecT String Integer (State PState) [RTProp BTyCon BTyVar RReft]
forall tv r c.
(IsString tv, Monoid r) =>
Parser [Ref (RType c tv r) BareType]
predicatesP (ParsecT String Integer (State PState) BareType
-> Parser String
-> ParsecT String Integer (State PState) [BareType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String Integer (State PState) BareType
bareTyArgP Parser String
blanks) Parser Predicate
mmonoPredicateP
           -- starts with "'" or upper case char
 ParsecT String Integer (State PState) (Reft -> BareType)
-> String
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"bbaseP"
 where
   parseHelper :: ParsecT String Integer (State PState) (Reft -> BareType)
parseHelper = do
     Symbol
l <- Parser Symbol
lowerIdP
     Symbol -> ParsecT String Integer (State PState) (Reft -> BareType)
lowerIdTail Symbol
l

maybeBind :: Parser a -> Parser (Maybe Symbol, a)
maybeBind :: Parser a -> Parser (Maybe Symbol, a)
maybeBind Parser a
p = do {Maybe Symbol
bd <- Parser Symbol
-> ParsecT String Integer (State PState) (Maybe Symbol)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeP' Parser Symbol
bbindP; a
ty <- Parser a
p ; (Maybe Symbol, a) -> Parser (Maybe Symbol, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Symbol
bd, a
ty)}
  where
    maybeP' :: ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeP' ParsecT s u m a
p = ParsecT s u m (Maybe a) -> ParsecT s u m (Maybe a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> ParsecT s u m a -> ParsecT s u m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m a
p)
             ParsecT s u m (Maybe a)
-> ParsecT s u m (Maybe a) -> ParsecT s u m (Maybe a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe a -> ParsecT s u m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

lowerIdTail :: Symbol -> Parser (Reft -> BareType)
lowerIdTail :: Symbol -> ParsecT String Integer (State PState) (Reft -> BareType)
lowerIdTail Symbol
l =
     (    ((BTyVar -> [BareType] -> Reft -> BareType)
-> ParsecT String Integer (State PState) BTyVar
-> ParsecT String Integer (State PState) [BareType]
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 BTyVar -> [BareType] -> Reft -> BareType
forall (t :: * -> *) r tv c.
(Foldable t, PPrint r, Reftable r) =>
tv -> t (RType c tv (UReft r)) -> r -> RType c tv (UReft r)
bAppTy (BTyVar -> ParsecT String Integer (State PState) BTyVar
forall (m :: * -> *) a. Monad m => a -> m a
return (BTyVar -> ParsecT String Integer (State PState) BTyVar)
-> BTyVar -> ParsecT String Integer (State PState) BTyVar
forall a b. (a -> b) -> a -> b
$ Symbol -> BTyVar
bTyVar Symbol
l) (ParsecT String Integer (State PState) BareType
-> Parser String
-> ParsecT String Integer (State PState) [BareType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT String Integer (State PState) BareType
bareTyArgP Parser String
blanks))
      ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((BTyVar -> Predicate -> Reft -> BareType)
-> ParsecT String Integer (State PState) BTyVar
-> Parser Predicate
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 BTyVar -> Predicate -> Reft -> BareType
forall tv r c. tv -> Predicate -> r -> RType c tv (UReft r)
bRVar  (BTyVar -> ParsecT String Integer (State PState) BTyVar
forall (m :: * -> *) a. Monad m => a -> m a
return (BTyVar -> ParsecT String Integer (State PState) BTyVar)
-> BTyVar -> ParsecT String Integer (State PState) BTyVar
forall a b. (a -> b) -> a -> b
$ Symbol -> BTyVar
bTyVar Symbol
l) Parser Predicate
monoPredicateP))

bTyConP :: Parser BTyCon
bTyConP :: ParsecT String Integer (State PState) BTyCon
bTyConP
  =  (String -> Parser ()
reservedOp String
"'" Parser ()
-> ParsecT String Integer (State PState) BTyCon
-> ParsecT String Integer (State PState) BTyCon
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (LocSymbol -> BTyCon
mkPromotedBTyCon (LocSymbol -> BTyCon)
-> ParsecT String Integer (State PState) LocSymbol
-> ParsecT String Integer (State PState) BTyCon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) LocSymbol
locUpperIdP))
 ParsecT String Integer (State PState) BTyCon
-> ParsecT String Integer (State PState) BTyCon
-> ParsecT String Integer (State PState) BTyCon
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> LocSymbol -> BTyCon
mkBTyCon (LocSymbol -> BTyCon)
-> ParsecT String Integer (State PState) LocSymbol
-> ParsecT String Integer (State PState) BTyCon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) LocSymbol
locUpperIdP
 ParsecT String Integer (State PState) BTyCon
-> ParsecT String Integer (State PState) BTyCon
-> ParsecT String Integer (State PState) BTyCon
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"*" Parser ()
-> ParsecT String Integer (State PState) BTyCon
-> ParsecT String Integer (State PState) BTyCon
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (BTyCon -> ParsecT String Integer (State PState) BTyCon
forall (m :: * -> *) a. Monad m => a -> m a
return (BTyCon -> ParsecT String Integer (State PState) BTyCon)
-> BTyCon -> ParsecT String Integer (State PState) BTyCon
forall a b. (a -> b) -> a -> b
$ LocSymbol -> BTyCon
mkBTyCon (Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc (Symbol -> LocSymbol) -> Symbol -> LocSymbol
forall a b. (a -> b) -> a -> b
$ String -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (String
"*" :: String))))
 ParsecT String Integer (State PState) BTyCon
-> String -> ParsecT String Integer (State PState) BTyCon
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"bTyConP"

mkPromotedBTyCon :: LocSymbol -> BTyCon
mkPromotedBTyCon :: LocSymbol -> BTyCon
mkPromotedBTyCon LocSymbol
x = LocSymbol -> Bool -> Bool -> BTyCon
BTyCon LocSymbol
x Bool
False Bool
True -- (consSym '\'' <$> x) False True

classBTyConP :: Parser BTyCon
classBTyConP :: ParsecT String Integer (State PState) BTyCon
classBTyConP = LocSymbol -> BTyCon
mkClassBTyCon (LocSymbol -> BTyCon)
-> ParsecT String Integer (State PState) LocSymbol
-> ParsecT String Integer (State PState) BTyCon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) LocSymbol
locUpperIdP

mkClassBTyCon :: LocSymbol -> BTyCon
mkClassBTyCon :: LocSymbol -> BTyCon
mkClassBTyCon LocSymbol
x = LocSymbol -> Bool -> Bool -> BTyCon
BTyCon LocSymbol
x Bool
True Bool
False

bbaseNoAppP :: Parser (Reft -> BareType)
bbaseNoAppP :: ParsecT String Integer (State PState) (Reft -> BareType)
bbaseNoAppP
  =  ParsecT String Integer (State PState) (Reft -> BareType)
holeRefP
 ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Maybe BareType
 -> [RTProp BTyCon BTyVar RReft] -> Reft -> BareType)
-> ParsecT String Integer (State PState) (Maybe BareType)
-> ParsecT
     String Integer (State PState) [RTProp BTyCon BTyVar RReft]
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe BareType -> [RTProp BTyCon BTyVar RReft] -> Reft -> BareType
forall tv r.
Maybe (RType BTyCon tv (UReft r))
-> [RTProp BTyCon tv (UReft r)] -> r -> RType BTyCon tv (UReft r)
bLst (ParsecT String Integer (State PState) (Maybe BareType)
-> ParsecT String Integer (State PState) (Maybe BareType)
forall u a. ParserT u a -> ParserT u a
brackets (ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Maybe BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeP ParsecT String Integer (State PState) BareType
bareTypeP)) ParsecT String Integer (State PState) [RTProp BTyCon BTyVar RReft]
forall tv r c.
(IsString tv, Monoid r) =>
Parser [Ref (RType c tv r) BareType]
predicatesP
 ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([(Maybe Symbol, BareType)]
 -> [RTProp BTyCon BTyVar RReft] -> Reft -> BareType)
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
-> ParsecT
     String Integer (State PState) [RTProp BTyCon BTyVar RReft]
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [(Maybe Symbol, BareType)]
-> [RTProp BTyCon BTyVar RReft] -> Reft -> BareType
forall r.
(PPrint r, Reftable r, Reftable (RType BTyCon BTyVar (UReft r)),
 Reftable (RTProp BTyCon BTyVar (UReft r))) =>
[(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
-> [RTProp BTyCon BTyVar (UReft r)]
-> r
-> RType BTyCon BTyVar (UReft r)
bTup (ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
forall u a. ParserT u a -> ParserT u a
parens (ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
 -> ParsecT
      String Integer (State PState) [(Maybe Symbol, BareType)])
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
forall a b. (a -> b) -> a -> b
$ ParsecT String Integer (State PState) (Maybe Symbol, BareType)
-> Parser String
-> ParsecT String Integer (State PState) [(Maybe Symbol, BareType)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Maybe Symbol, BareType)
forall a. Parser a -> Parser (Maybe Symbol, a)
maybeBind ParsecT String Integer (State PState) BareType
bareTypeP) Parser String
comma) ParsecT String Integer (State PState) [RTProp BTyCon BTyVar RReft]
forall tv r c.
(IsString tv, Monoid r) =>
Parser [Ref (RType c tv r) BareType]
predicatesP
 ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((BTyCon
 -> [RTProp BTyCon BTyVar RReft]
 -> [BareType]
 -> Predicate
 -> Reft
 -> BareType)
-> ParsecT String Integer (State PState) BTyCon
-> ParsecT
     String Integer (State PState) [RTProp BTyCon BTyVar RReft]
-> ParsecT String Integer (State PState) [BareType]
-> Parser Predicate
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 BTyCon
-> [RTProp BTyCon BTyVar RReft]
-> [BareType]
-> Predicate
-> Reft
-> BareType
forall c tv r.
c
-> [RTProp c tv (UReft r)]
-> [RType c tv (UReft r)]
-> Predicate
-> r
-> RType c tv (UReft r)
bCon ParsecT String Integer (State PState) BTyCon
bTyConP ParsecT String Integer (State PState) [RTProp BTyCon BTyVar RReft]
forall tv r c.
(IsString tv, Monoid r) =>
Parser [Ref (RType c tv r) BareType]
predicatesP ([BareType] -> ParsecT String Integer (State PState) [BareType]
forall (m :: * -> *) a. Monad m => a -> m a
return []) (Predicate -> Parser Predicate
forall (m :: * -> *) a. Monad m => a -> m a
return Predicate
forall a. Monoid a => a
mempty))
 ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (BTyVar -> Predicate -> Reft -> BareType)
-> ParsecT String Integer (State PState) BTyVar
-> Parser Predicate
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 BTyVar -> Predicate -> Reft -> BareType
forall tv r c. tv -> Predicate -> r -> RType c tv (UReft r)
bRVar (Symbol -> BTyVar
bTyVar (Symbol -> BTyVar)
-> Parser Symbol -> ParsecT String Integer (State PState) BTyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
lowerIdP) Parser Predicate
monoPredicateP
 ParsecT String Integer (State PState) (Reft -> BareType)
-> String
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"bbaseNoAppP"

maybeP :: ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeP :: ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeP ParsecT s u m a
p = (a -> Maybe a) -> ParsecT s u m a -> ParsecT s u m (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just ParsecT s u m a
p ParsecT s u m (Maybe a)
-> ParsecT s u m (Maybe a) -> ParsecT s u m (Maybe a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe a -> ParsecT s u m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

bareTyArgP :: Parser BareType
bareTyArgP :: ParsecT String Integer (State PState) BareType
bareTyArgP
  =  (Located Expr -> BareType
forall c tv r. Located Expr -> RType c tv r
RExprArg (Located Expr -> BareType)
-> (Located Integer -> Located Expr) -> Located Integer -> BareType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Expr) -> Located Integer -> Located Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Expr
forall a. Expression a => a -> Expr
expr (Located Integer -> BareType)
-> ParsecT String Integer (State PState) (Located Integer)
-> ParsecT String Integer (State PState) BareType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
-> ParsecT String Integer (State PState) (Located Integer)
forall a. Parser a -> Parser (Located a)
locParserP Parser Integer
integer)
 ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall u a. ParserT u a -> ParserT u a
braces (ParsecT String Integer (State PState) BareType
 -> ParsecT String Integer (State PState) BareType)
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall a b. (a -> b) -> a -> b
$ Located Expr -> BareType
forall c tv r. Located Expr -> RType c tv r
RExprArg (Located Expr -> BareType)
-> ParsecT String Integer (State PState) (Located Expr)
-> ParsecT String Integer (State PState) BareType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr -> ParsecT String Integer (State PState) (Located Expr)
forall a. Parser a -> Parser (Located a)
locParserP Parser Expr
exprP)
 ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String Integer (State PState) BareType
bareAtomNoAppP
 ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall u a. ParserT u a -> ParserT u a
parens ParsecT String Integer (State PState) BareType
bareTypeP)
 ParsecT String Integer (State PState) BareType
-> String -> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"bareTyArgP"

bareAtomNoAppP :: Parser BareType
bareAtomNoAppP :: ParsecT String Integer (State PState) BareType
bareAtomNoAppP
  =  ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
refP ParsecT String Integer (State PState) (Reft -> BareType)
bbaseNoAppP
 ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) b. Monad m => m (Reft -> b) -> m b
dummyP (ParsecT String Integer (State PState) (Reft -> BareType)
bbaseNoAppP ParsecT String Integer (State PState) (Reft -> BareType)
-> Parser String
-> ParsecT String Integer (State PState) (Reft -> BareType)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
blanks))
 ParsecT String Integer (State PState) BareType
-> String -> ParsecT String Integer (State PState) BareType
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"bareAtomNoAppP"


constraintP :: Parser BareType
constraintP :: ParsecT String Integer (State PState) BareType
constraintP
  = do [(LocSymbol, BareType)]
xts <- Parser [(LocSymbol, BareType)]
constraintEnvP
       BareType
t1  <- ParsecT String Integer (State PState) BareType
bareTypeP
       String -> Parser ()
reservedOp String
"<:"
       BareType
t2  <- ParsecT String Integer (State PState) BareType
bareTypeP
       BareType -> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) a. Monad m => a -> m a
return (BareType -> ParsecT String Integer (State PState) BareType)
-> BareType -> ParsecT String Integer (State PState) BareType
forall a b. (a -> b) -> a -> b
$ RTypeRep BTyCon BTyVar RReft -> BareType
forall c tv r. RTypeRep c tv r -> RType c tv r
fromRTypeRep (RTypeRep BTyCon BTyVar RReft -> BareType)
-> RTypeRep BTyCon BTyVar RReft -> BareType
forall a b. (a -> b) -> a -> b
$ [(RTVar BTyVar (RType BTyCon BTyVar ()), RReft)]
-> [PVar (RType BTyCon BTyVar ())]
-> [Symbol]
-> [RReft]
-> [BareType]
-> [Symbol]
-> [RReft]
-> [BareType]
-> BareType
-> RTypeRep BTyCon BTyVar RReft
forall c tv r.
[(RTVar tv (RType c tv ()), r)]
-> [PVar (RType c tv ())]
-> [Symbol]
-> [r]
-> [RType c tv r]
-> [Symbol]
-> [r]
-> [RType c tv r]
-> RType c tv r
-> RTypeRep c tv r
RTypeRep [] [] []
                                        [] [] 
                                        ((LocSymbol -> Symbol
forall a. Located a -> a
val (LocSymbol -> Symbol)
-> ((LocSymbol, BareType) -> LocSymbol)
-> (LocSymbol, BareType)
-> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocSymbol, BareType) -> LocSymbol
forall a b. (a, b) -> a
fst ((LocSymbol, BareType) -> Symbol)
-> [(LocSymbol, BareType)] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(LocSymbol, BareType)]
xts) [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
++ [Symbol
dummySymbol])
                                        (Line -> RReft -> [RReft]
forall a. Line -> a -> [a]
replicate ([(LocSymbol, BareType)] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length [(LocSymbol, BareType)]
xts Line -> Line -> Line
forall a. Num a => a -> a -> a
+ Line
1) RReft
forall a. Monoid a => a
mempty)
                                        (((LocSymbol, BareType) -> BareType
forall a b. (a, b) -> b
snd ((LocSymbol, BareType) -> BareType)
-> [(LocSymbol, BareType)] -> [BareType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(LocSymbol, BareType)]
xts) [BareType] -> [BareType] -> [BareType]
forall a. [a] -> [a] -> [a]
++ [BareType
t1]) BareType
t2

constraintEnvP :: Parser [(LocSymbol, BareType)]
constraintEnvP :: Parser [(LocSymbol, BareType)]
constraintEnvP
   =  Parser [(LocSymbol, BareType)] -> Parser [(LocSymbol, BareType)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do [(LocSymbol, BareType)]
xts <- ParsecT String Integer (State PState) (LocSymbol, BareType)
-> Parser String -> Parser [(LocSymbol, BareType)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String Integer (State PState) (LocSymbol, BareType)
tyBindNoLocP Parser String
comma
              String -> Parser ()
reservedOp String
"|-"
              [(LocSymbol, BareType)] -> Parser [(LocSymbol, BareType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(LocSymbol, BareType)]
xts)
  Parser [(LocSymbol, BareType)]
-> Parser [(LocSymbol, BareType)] -> Parser [(LocSymbol, BareType)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [(LocSymbol, BareType)] -> Parser [(LocSymbol, BareType)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Parser [(LocSymbol, BareType)]
-> String -> Parser [(LocSymbol, BareType)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"constraintEnvP"

rrTy :: Monoid r => RType c tv r -> RType c tv r -> RType c tv r
rrTy :: RType c tv r -> RType c tv r -> RType c tv r
rrTy RType c tv r
ct = [(Symbol, RType c tv r)]
-> r -> Oblig -> RType c tv r -> RType c tv r
forall c tv r.
[(Symbol, RType c tv r)]
-> r -> Oblig -> RType c tv r -> RType c tv r
RRTy ([(Symbol, RType c tv r)]
xts [(Symbol, RType c tv r)]
-> [(Symbol, RType c tv r)] -> [(Symbol, RType c tv r)]
forall a. [a] -> [a] -> [a]
++ [(Symbol
dummySymbol, RType c tv r
tr)]) r
forall a. Monoid a => a
mempty Oblig
OCons
  where
    tr :: RType c tv r
tr   = RTypeRep c tv r -> RType c tv r
forall c tv r. RTypeRep c tv r -> RType c tv r
ty_res RTypeRep c tv r
trep
    xts :: [(Symbol, RType c tv r)]
xts  = [Symbol] -> [RType c tv r] -> [(Symbol, RType c tv r)]
forall a b. [a] -> [b] -> [(a, b)]
zip (RTypeRep c tv r -> [Symbol]
forall c tv r. RTypeRep c tv r -> [Symbol]
ty_binds RTypeRep c tv r
trep) (RTypeRep c tv r -> [RType c tv r]
forall c tv r. RTypeRep c tv r -> [RType c tv r]
ty_args RTypeRep c tv r
trep)
    trep :: RTypeRep c tv r
trep = RType c tv r -> RTypeRep c tv r
forall c tv r. RType c tv r -> RTypeRep c tv r
toRTypeRep RType c tv r
ct

--  "forall <z w> . TYPE"
-- or
--  "forall x y <z :: Nat, w :: Int> . TYPE"
bareAllP :: Parser BareType
bareAllP :: ParsecT String Integer (State PState) BareType
bareAllP = do
  [BTyVar]
as <- Parser [BTyVar]
tyVarDefsP
  [PVar (RType BTyCon BTyVar ())]
ps <- Parser [PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
forall a.
ParsecT String Integer (State PState) a
-> ParsecT String Integer (State PState) a
angles Parser [PVar (RType BTyCon BTyVar ())]
inAngles
        Parser [PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
  Parser String
dot
  BareType
t <- ParsecT String Integer (State PState) BareType
bareTypeP
  BareType -> ParsecT String Integer (State PState) BareType
forall (m :: * -> *) a. Monad m => a -> m a
return (BareType -> ParsecT String Integer (State PState) BareType)
-> BareType -> ParsecT String Integer (State PState) BareType
forall a b. (a -> b) -> a -> b
$ (RTVar BTyVar (RType BTyCon BTyVar ()) -> BareType -> BareType)
-> BareType -> [RTVar BTyVar (RType BTyCon BTyVar ())] -> BareType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RTVar BTyVar (RType BTyCon BTyVar ()) -> BareType -> BareType
forall r c tv.
Monoid r =>
RTVU c tv -> RType c tv r -> RType c tv r
rAllT ((PVar (RType BTyCon BTyVar ()) -> BareType -> BareType)
-> BareType -> [PVar (RType BTyCon BTyVar ())] -> BareType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PVar (RType BTyCon BTyVar ()) -> BareType -> BareType
forall c tv r. PVU c tv -> RType c tv r -> RType c tv r
RAllP BareType
t [PVar (RType BTyCon BTyVar ())]
ps) (BTyVar -> RTVar BTyVar (RType BTyCon BTyVar ())
forall tv s. tv -> RTVar tv s
makeRTVar (BTyVar -> RTVar BTyVar (RType BTyCon BTyVar ()))
-> [BTyVar] -> [RTVar BTyVar (RType BTyCon BTyVar ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BTyVar]
as)
  where
    rAllT :: RTVU c tv -> RType c tv r -> RType c tv r
rAllT RTVU c tv
a RType c tv r
t = RTVU c tv -> RType c tv r -> r -> RType c tv r
forall c tv r. RTVU c tv -> RType c tv r -> r -> RType c tv r
RAllT RTVU c tv
a RType c tv r
t r
forall a. Monoid a => a
mempty
    inAngles :: Parser [PVar (RType BTyCon BTyVar ())]
inAngles =
      (
       (Parser [PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try  (ParsecT
  String Integer (State PState) (PVar (RType BTyCon BTyVar ()))
-> Parser String -> Parser [PVar (RType BTyCon BTyVar ())]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy  ParsecT
  String Integer (State PState) (PVar (RType BTyCon BTyVar ()))
predVarDefP Parser String
comma))
       )

tyVarDefsP :: Parser [BTyVar]
tyVarDefsP :: Parser [BTyVar]
tyVarDefsP
  = (Parser [BTyVar] -> Parser [BTyVar]
forall u a. ParserT u a -> ParserT u a
parens (Parser [BTyVar] -> Parser [BTyVar])
-> Parser [BTyVar] -> Parser [BTyVar]
forall a b. (a -> b) -> a -> b
$ ParsecT String Integer (State PState) BTyVar -> Parser [BTyVar]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Symbol -> BTyVar
bTyVar (Symbol -> BTyVar)
-> Parser Symbol -> ParsecT String Integer (State PState) BTyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
tyKindVarIdP))
 Parser [BTyVar] -> Parser [BTyVar] -> Parser [BTyVar]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) BTyVar -> Parser [BTyVar]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Symbol -> BTyVar
bTyVar (Symbol -> BTyVar)
-> Parser Symbol -> ParsecT String Integer (State PState) BTyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
tyVarIdP)
 Parser [BTyVar] -> String -> Parser [BTyVar]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"tyVarDefsP"

-- TODO:AZ use something from Token instead
tyVarIdP :: Parser Symbol
tyVarIdP :: Parser Symbol
tyVarIdP = Symbol -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Symbol -> Symbol) -> Parser Symbol -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) Char
-> HashSet Char -> (String -> Bool) -> Parser Symbol
condIdP (ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lower ParsecT String Integer (State PState) Char
-> ParsecT String Integer (State PState) Char
-> ParsecT String Integer (State PState) Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_') HashSet Char
alphanums String -> Bool
isNotReserved -- (isSmall . head)
  where
    alphanums :: HashSet Char
alphanums = String -> HashSet Char
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList (String -> HashSet Char) -> String -> HashSet Char
forall a b. (a -> b) -> a -> b
$ [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9']

tyKindVarIdP :: Parser Symbol
tyKindVarIdP :: Parser Symbol
tyKindVarIdP = do
   Symbol
tv <- Parser Symbol
tyVarIdP
   (  (do String -> Parser ()
reservedOp String
"::"; BareType
_ <- ParsecT String Integer (State PState) BareType
kindP; Symbol -> Parser Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
tv)
    Parser Symbol -> Parser Symbol -> Parser Symbol
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Symbol -> Parser Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
tv)

kindP :: Parser BareType
kindP :: ParsecT String Integer (State PState) BareType
kindP = ParsecT String Integer (State PState) BareType
bareAtomBindP

predVarDefsP :: Parser [PVar BSort]
predVarDefsP :: Parser [PVar (RType BTyCon BTyVar ())]
predVarDefsP
  =  (Parser [PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
forall a.
ParsecT String Integer (State PState) a
-> ParsecT String Integer (State PState) a
angles (Parser [PVar (RType BTyCon BTyVar ())]
 -> Parser [PVar (RType BTyCon BTyVar ())])
-> Parser [PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
forall a b. (a -> b) -> a -> b
$ ParsecT
  String Integer (State PState) (PVar (RType BTyCon BTyVar ()))
-> Parser String -> Parser [PVar (RType BTyCon BTyVar ())]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT
  String Integer (State PState) (PVar (RType BTyCon BTyVar ()))
predVarDefP Parser String
comma)
 Parser [PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [PVar (RType BTyCon BTyVar ())]
-> Parser [PVar (RType BTyCon BTyVar ())]
forall (m :: * -> *) a. Monad m => a -> m a
return []
 Parser [PVar (RType BTyCon BTyVar ())]
-> String -> Parser [PVar (RType BTyCon BTyVar ())]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"predVarDefP"

predVarDefP :: Parser (PVar BSort)
predVarDefP :: ParsecT
  String Integer (State PState) (PVar (RType BTyCon BTyVar ()))
predVarDefP
  = Symbol
-> String
-> [(Symbol, RType BTyCon BTyVar ())]
-> PVar (RType BTyCon BTyVar ())
forall t t1. Symbol -> t -> [(Symbol, t1)] -> PVar t1
bPVar (Symbol
 -> String
 -> [(Symbol, RType BTyCon BTyVar ())]
 -> PVar (RType BTyCon BTyVar ()))
-> Parser Symbol
-> ParsecT
     String
     Integer
     (State PState)
     (String
      -> [(Symbol, RType BTyCon BTyVar ())]
      -> PVar (RType BTyCon BTyVar ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
predVarIdP ParsecT
  String
  Integer
  (State PState)
  (String
   -> [(Symbol, RType BTyCon BTyVar ())]
   -> PVar (RType BTyCon BTyVar ()))
-> Parser String
-> ParsecT
     String
     Integer
     (State PState)
     ([(Symbol, RType BTyCon BTyVar ())]
      -> PVar (RType BTyCon BTyVar ()))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
dcolon ParsecT
  String
  Integer
  (State PState)
  ([(Symbol, RType BTyCon BTyVar ())]
   -> PVar (RType BTyCon BTyVar ()))
-> ParsecT
     String Integer (State PState) [(Symbol, RType BTyCon BTyVar ())]
-> ParsecT
     String Integer (State PState) (PVar (RType BTyCon BTyVar ()))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
  String Integer (State PState) [(Symbol, RType BTyCon BTyVar ())]
propositionSortP

predVarIdP :: Parser Symbol
predVarIdP :: Parser Symbol
predVarIdP
  = Symbol -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Symbol -> Symbol) -> Parser Symbol -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
tyVarIdP

bPVar :: Symbol -> t -> [(Symbol, t1)] -> PVar t1
bPVar :: Symbol -> t -> [(Symbol, t1)] -> PVar t1
bPVar Symbol
p t
_ [(Symbol, t1)]
xts  = Symbol -> PVKind t1 -> Symbol -> [(t1, Symbol, Expr)] -> PVar t1
forall t.
Symbol -> PVKind t -> Symbol -> [(t, Symbol, Expr)] -> PVar t
PV Symbol
p (t1 -> PVKind t1
forall t. t -> PVKind t
PVProp t1
τ) Symbol
dummySymbol [(t1, Symbol, Expr)]
τxs
  where
    (Symbol
_, t1
τ) = String -> [(Symbol, t1)] -> (Symbol, t1)
forall p. String -> [p] -> p
safeLast String
"bPVar last" [(Symbol, t1)]
xts
    τxs :: [(t1, Symbol, Expr)]
τxs    = [ (t1
τ, Symbol
x, Symbol -> Expr
EVar Symbol
x) | (Symbol
x, t1
τ) <- [(Symbol, t1)] -> [(Symbol, t1)]
forall a. [a] -> [a]
init [(Symbol, t1)]
xts ]
    safeLast :: String -> [p] -> p
safeLast String
_ xs :: [p]
xs@(p
_:[p]
_) = [p] -> p
forall a. [a] -> a
last [p]
xs
    safeLast String
msg [p]
_      = Maybe SrcSpan -> String -> p
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"safeLast with empty list " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg

propositionSortP :: Parser [(Symbol, BSort)]
propositionSortP :: ParsecT
  String Integer (State PState) [(Symbol, RType BTyCon BTyVar ())]
propositionSortP = ((Symbol, BareType) -> (Symbol, RType BTyCon BTyVar ()))
-> [(Symbol, BareType)] -> [(Symbol, RType BTyCon BTyVar ())]
forall a b. (a -> b) -> [a] -> [b]
map ((BareType -> RType BTyCon BTyVar ())
-> (Symbol, BareType) -> (Symbol, RType BTyCon BTyVar ())
forall b c a. (b -> c) -> (a, b) -> (a, c)
Misc.mapSnd BareType -> RType BTyCon BTyVar ()
forall c tv r. RType c tv r -> RType c tv ()
toRSort) ([(Symbol, BareType)] -> [(Symbol, RType BTyCon BTyVar ())])
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
-> ParsecT
     String Integer (State PState) [(Symbol, RType BTyCon BTyVar ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) [(Symbol, BareType)]
propositionTypeP

propositionTypeP :: Parser [(Symbol, BareType)]
propositionTypeP :: ParsecT String Integer (State PState) [(Symbol, BareType)]
propositionTypeP = (String
 -> ParsecT String Integer (State PState) [(Symbol, BareType)])
-> ([(Symbol, BareType)]
    -> ParsecT String Integer (State PState) [(Symbol, BareType)])
-> Either String [(Symbol, BareType)]
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail [(Symbol, BareType)]
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [(Symbol, BareType)]
 -> ParsecT String Integer (State PState) [(Symbol, BareType)])
-> ParsecT
     String Integer (State PState) (Either String [(Symbol, BareType)])
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (BareType -> Either String [(Symbol, BareType)]
mkPropositionType (BareType -> Either String [(Symbol, BareType)])
-> ParsecT String Integer (State PState) BareType
-> ParsecT
     String Integer (State PState) (Either String [(Symbol, BareType)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) BareType
bareTypeP)

mkPropositionType :: BareType -> Either String [(Symbol, BareType)]
mkPropositionType :: BareType -> Either String [(Symbol, BareType)]
mkPropositionType BareType
t
  | Bool
isOk      = [(Symbol, BareType)] -> Either String [(Symbol, BareType)]
forall a b. b -> Either a b
Right ([(Symbol, BareType)] -> Either String [(Symbol, BareType)])
-> [(Symbol, BareType)] -> Either String [(Symbol, BareType)]
forall a b. (a -> b) -> a -> b
$ [Symbol] -> [BareType] -> [(Symbol, BareType)]
forall a b. [a] -> [b] -> [(a, b)]
zip (RTypeRep BTyCon BTyVar RReft -> [Symbol]
forall c tv r. RTypeRep c tv r -> [Symbol]
ty_binds RTypeRep BTyCon BTyVar RReft
tRep) (RTypeRep BTyCon BTyVar RReft -> [BareType]
forall c tv r. RTypeRep c tv r -> [RType c tv r]
ty_args RTypeRep BTyCon BTyVar RReft
tRep)
  | Bool
otherwise = String -> Either String [(Symbol, BareType)]
forall a b. a -> Either a b
Left String
err
  where
    isOk :: Bool
isOk      = BareType -> Bool
forall t t1. RType BTyCon t t1 -> Bool
isPropBareType (RTypeRep BTyCon BTyVar RReft -> BareType
forall c tv r. RTypeRep c tv r -> RType c tv r
ty_res RTypeRep BTyCon BTyVar RReft
tRep)
    tRep :: RTypeRep BTyCon BTyVar RReft
tRep      = BareType -> RTypeRep BTyCon BTyVar RReft
forall c tv r. RType c tv r -> RTypeRep c tv r
toRTypeRep BareType
t
    err :: String
err       = String
"Proposition type with non-Bool output: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ BareType -> String
forall a. PPrint a => a -> String
showpp BareType
t

xyP :: Parser x -> Parser a -> Parser y -> Parser (x, y)
xyP :: Parser x -> Parser a -> Parser y -> Parser (x, y)
xyP Parser x
lP Parser a
sepP Parser y
rP = (\x
x a
_ y
y -> (x
x, y
y)) (x -> a -> y -> (x, y))
-> Parser x
-> ParsecT String Integer (State PState) (a -> y -> (x, y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser x
lP ParsecT String Integer (State PState) (a -> y -> (x, y))
-> Parser a -> ParsecT String Integer (State PState) (y -> (x, y))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces Parser () -> Parser a -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a
sepP) ParsecT String Integer (State PState) (y -> (x, y))
-> Parser y -> Parser (x, y)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser y
rP

dummyBindP :: Parser Symbol
dummyBindP :: Parser Symbol
dummyBindP = Symbol -> Integer -> Symbol
tempSymbol Symbol
"db" (Integer -> Symbol) -> Parser Integer -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
freshIntP

isPropBareType :: RType BTyCon t t1 -> Bool
isPropBareType :: RType BTyCon t t1 -> Bool
isPropBareType  = Symbol -> RType BTyCon t t1 -> Bool
forall t t1. Symbol -> RType BTyCon t t1 -> Bool
isPrimBareType Symbol
boolConName

isPrimBareType :: Symbol -> RType BTyCon t t1 -> Bool
isPrimBareType :: Symbol -> RType BTyCon t t1 -> Bool
isPrimBareType Symbol
n (RApp BTyCon
tc [] [RTProp BTyCon t t1]
_ t1
_) = LocSymbol -> Symbol
forall a. Located a -> a
val (BTyCon -> LocSymbol
btc_tc BTyCon
tc) Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
n
isPrimBareType Symbol
_ RType BTyCon t t1
_                = Bool
False

getClasses :: RType BTyCon t t1 -> [RType BTyCon t t1]
getClasses :: RType BTyCon t t1 -> [RType BTyCon t t1]
getClasses (RApp BTyCon
tc [RType BTyCon t t1]
ts [RTProp BTyCon t t1]
ps t1
r)
  | BTyCon -> Bool
forall c. TyConable c => c -> Bool
isTuple BTyCon
tc
  = (RType BTyCon t t1 -> [RType BTyCon t t1])
-> [RType BTyCon t t1] -> [RType BTyCon t t1]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RType BTyCon t t1 -> [RType BTyCon t t1]
forall t t1. RType BTyCon t t1 -> [RType BTyCon t t1]
getClasses [RType BTyCon t t1]
ts
  | Bool
otherwise
  = [BTyCon
-> [RType BTyCon t t1]
-> [RTProp BTyCon t t1]
-> t1
-> RType BTyCon t t1
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp (BTyCon
tc { btc_class :: Bool
btc_class = Bool
True }) [RType BTyCon t t1]
ts [RTProp BTyCon t t1]
ps t1
r]
getClasses RType BTyCon t t1
t
  = [RType BTyCon t t1
t]

dummyP ::  Monad m => m (Reft -> b) -> m b
dummyP :: m (Reft -> b) -> m b
dummyP m (Reft -> b)
fm
  = m (Reft -> b)
fm m (Reft -> b) -> m Reft -> m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Reft -> m Reft
forall (m :: * -> *) a. Monad m => a -> m a
return Reft
forall a. Monoid a => a
dummyReft

symsP :: (IsString tv, Monoid r)
      => Parser [(Symbol, RType c tv r)]
symsP :: Parser [(Symbol, RType c tv r)]
symsP
  = do String -> Parser ()
reservedOp String
"\\"
       [Symbol]
ss <- Parser Symbol
-> Parser () -> ParsecT String Integer (State PState) [Symbol]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy Parser Symbol
symbolP Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
       String -> Parser ()
reservedOp String
"->"
       [(Symbol, RType c tv r)] -> Parser [(Symbol, RType c tv r)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Symbol, RType c tv r)] -> Parser [(Symbol, RType c tv r)])
-> [(Symbol, RType c tv r)] -> Parser [(Symbol, RType c tv r)]
forall a b. (a -> b) -> a -> b
$ (, RType c tv r
forall tv r c. (IsString tv, Monoid r) => RType c tv r
dummyRSort) (Symbol -> (Symbol, RType c tv r))
-> [Symbol] -> [(Symbol, RType c tv r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
ss
 Parser [(Symbol, RType c tv r)]
-> Parser [(Symbol, RType c tv r)]
-> Parser [(Symbol, RType c tv r)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [(Symbol, RType c tv r)] -> Parser [(Symbol, RType c tv r)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
 Parser [(Symbol, RType c tv r)]
-> String -> Parser [(Symbol, RType c tv r)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"symsP"

dummyRSort :: (IsString tv, Monoid r) => RType c tv r
dummyRSort :: RType c tv r
dummyRSort
  = tv -> r -> RType c tv r
forall c tv r. tv -> r -> RType c tv r
RVar tv
"dummy" r
forall a. Monoid a => a
mempty

predicatesP :: (IsString tv, Monoid r)
            => Parser [Ref (RType c tv r) BareType]
predicatesP :: Parser [Ref (RType c tv r) BareType]
predicatesP
   =  (Parser [Ref (RType c tv r) BareType]
-> Parser [Ref (RType c tv r) BareType]
forall a.
ParsecT String Integer (State PState) a
-> ParsecT String Integer (State PState) a
angles (Parser [Ref (RType c tv r) BareType]
 -> Parser [Ref (RType c tv r) BareType])
-> Parser [Ref (RType c tv r) BareType]
-> Parser [Ref (RType c tv r) BareType]
forall a b. (a -> b) -> a -> b
$ ParsecT String Integer (State PState) (Ref (RType c tv r) BareType)
-> Parser String -> Parser [Ref (RType c tv r) BareType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT String Integer (State PState) (Ref (RType c tv r) BareType)
forall tv r c.
(IsString tv, Monoid r) =>
Parser (Ref (RType c tv r) BareType)
predicate1P Parser String
comma)
  Parser [Ref (RType c tv r) BareType]
-> Parser [Ref (RType c tv r) BareType]
-> Parser [Ref (RType c tv r) BareType]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Ref (RType c tv r) BareType]
-> Parser [Ref (RType c tv r) BareType]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Parser [Ref (RType c tv r) BareType]
-> String -> Parser [Ref (RType c tv r) BareType]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"predicatesP"

predicate1P :: (IsString tv, Monoid r)
            => Parser (Ref (RType c tv r) BareType)
predicate1P :: Parser (Ref (RType c tv r) BareType)
predicate1P
   =  Parser (Ref (RType c tv r) BareType)
-> Parser (Ref (RType c tv r) BareType)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([(Symbol, RType c tv r)] -> BareType -> Ref (RType c tv r) BareType
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp ([(Symbol, RType c tv r)]
 -> BareType -> Ref (RType c tv r) BareType)
-> ParsecT String Integer (State PState) [(Symbol, RType c tv r)]
-> ParsecT
     String
     Integer
     (State PState)
     (BareType -> Ref (RType c tv r) BareType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) [(Symbol, RType c tv r)]
forall tv r c.
(IsString tv, Monoid r) =>
Parser [(Symbol, RType c tv r)]
symsP ParsecT
  String
  Integer
  (State PState)
  (BareType -> Ref (RType c tv r) BareType)
-> ParsecT String Integer (State PState) BareType
-> Parser (Ref (RType c tv r) BareType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String Integer (State PState) (Reft -> BareType)
-> ParsecT String Integer (State PState) BareType
refP ParsecT String Integer (State PState) (Reft -> BareType)
bbaseP)
  Parser (Ref (RType c tv r) BareType)
-> Parser (Ref (RType c tv r) BareType)
-> Parser (Ref (RType c tv r) BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([(Symbol, RType c tv r)] -> RReft -> Ref (RType c tv r) BareType
forall τ r c tv. [(Symbol, τ)] -> r -> Ref τ (RType c tv r)
rPropP [] (RReft -> Ref (RType c tv r) BareType)
-> (Predicate -> RReft) -> Predicate -> Ref (RType c tv r) BareType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate -> RReft
forall r. Monoid r => Predicate -> UReft r
predUReft (Predicate -> Ref (RType c tv r) BareType)
-> Parser Predicate -> Parser (Ref (RType c tv r) BareType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Predicate
monoPredicate1P)
  Parser (Ref (RType c tv r) BareType)
-> Parser (Ref (RType c tv r) BareType)
-> Parser (Ref (RType c tv r) BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Parser (Ref (RType c tv r) BareType)
-> Parser (Ref (RType c tv r) BareType)
forall u a. ParserT u a -> ParserT u a
braces (Parser (Ref (RType c tv r) BareType)
 -> Parser (Ref (RType c tv r) BareType))
-> Parser (Ref (RType c tv r) BareType)
-> Parser (Ref (RType c tv r) BareType)
forall a b. (a -> b) -> a -> b
$ [((Symbol, RType c tv r), Symbol)]
-> Expr -> Ref (RType c tv r) BareType
forall τ c.
[((Symbol, τ), Symbol)] -> Expr -> Ref τ (RType c BTyVar RReft)
bRProp ([((Symbol, RType c tv r), Symbol)]
 -> Expr -> Ref (RType c tv r) BareType)
-> ParsecT
     String Integer (State PState) [((Symbol, RType c tv r), Symbol)]
-> ParsecT
     String Integer (State PState) (Expr -> Ref (RType c tv r) BareType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  String Integer (State PState) [((Symbol, RType c tv r), Symbol)]
forall tv r c.
(IsString tv, Monoid r) =>
ParsecT
  String Integer (State PState) [((Symbol, RType c tv r), Symbol)]
symsP' ParsecT
  String Integer (State PState) (Expr -> Ref (RType c tv r) BareType)
-> Parser Expr -> Parser (Ref (RType c tv r) BareType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Expr
refaP)
  Parser (Ref (RType c tv r) BareType)
-> String -> Parser (Ref (RType c tv r) BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"predicate1P"
   where
    symsP' :: ParsecT
  String Integer (State PState) [((Symbol, RType c tv r), Symbol)]
symsP'       = do [(Symbol, RType c tv r)]
ss    <- Parser [(Symbol, RType c tv r)]
forall tv r c.
(IsString tv, Monoid r) =>
Parser [(Symbol, RType c tv r)]
symsP
                      [Symbol]
fs    <- (Symbol -> Parser Symbol)
-> [Symbol] -> ParsecT String Integer (State PState) [Symbol]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Symbol -> Parser Symbol
refreshSym ((Symbol, RType c tv r) -> Symbol
forall a b. (a, b) -> a
fst ((Symbol, RType c tv r) -> Symbol)
-> [(Symbol, RType c tv r)] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Symbol, RType c tv r)]
ss)
                      [((Symbol, RType c tv r), Symbol)]
-> ParsecT
     String Integer (State PState) [((Symbol, RType c tv r), Symbol)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([((Symbol, RType c tv r), Symbol)]
 -> ParsecT
      String Integer (State PState) [((Symbol, RType c tv r), Symbol)])
-> [((Symbol, RType c tv r), Symbol)]
-> ParsecT
     String Integer (State PState) [((Symbol, RType c tv r), Symbol)]
forall a b. (a -> b) -> a -> b
$ [(Symbol, RType c tv r)]
-> [Symbol] -> [((Symbol, RType c tv r), Symbol)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Symbol, RType c tv r)]
ss [Symbol]
fs
    refreshSym :: Symbol -> Parser Symbol
refreshSym Symbol
s = Symbol -> Integer -> Symbol
forall a. Show a => Symbol -> a -> Symbol
intSymbol Symbol
s (Integer -> Symbol) -> Parser Integer -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
freshIntP

mmonoPredicateP :: Parser Predicate
mmonoPredicateP :: Parser Predicate
mmonoPredicateP
   = Parser Predicate -> Parser Predicate
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser Predicate -> Parser Predicate
forall a.
ParsecT String Integer (State PState) a
-> ParsecT String Integer (State PState) a
angles (Parser Predicate -> Parser Predicate)
-> Parser Predicate -> Parser Predicate
forall a b. (a -> b) -> a -> b
$ Parser Predicate -> Parser Predicate
forall a.
ParsecT String Integer (State PState) a
-> ParsecT String Integer (State PState) a
angles Parser Predicate
monoPredicate1P)
  Parser Predicate -> Parser Predicate -> Parser Predicate
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Predicate -> Parser Predicate
forall (m :: * -> *) a. Monad m => a -> m a
return Predicate
forall a. Monoid a => a
mempty
  Parser Predicate -> String -> Parser Predicate
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"mmonoPredicateP"

monoPredicateP :: Parser Predicate
monoPredicateP :: Parser Predicate
monoPredicateP
   = Parser Predicate -> Parser Predicate
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser Predicate -> Parser Predicate
forall a.
ParsecT String Integer (State PState) a
-> ParsecT String Integer (State PState) a
angles Parser Predicate
monoPredicate1P)
  Parser Predicate -> Parser Predicate -> Parser Predicate
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Predicate -> Parser Predicate
forall (m :: * -> *) a. Monad m => a -> m a
return Predicate
forall a. Monoid a => a
mempty
  Parser Predicate -> String -> Parser Predicate
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"monoPredicateP"

monoPredicate1P :: Parser Predicate
monoPredicate1P :: Parser Predicate
monoPredicate1P
   =  (String -> Parser ()
reserved String
"True" Parser () -> Parser Predicate -> Parser Predicate
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Predicate -> Parser Predicate
forall (m :: * -> *) a. Monad m => a -> m a
return Predicate
forall a. Monoid a => a
mempty)
  Parser Predicate -> Parser Predicate -> Parser Predicate
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (PVar String -> Predicate
forall t. PVar t -> Predicate
pdVar (PVar String -> Predicate)
-> ParsecT String Integer (State PState) (PVar String)
-> Parser Predicate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) (PVar String)
-> ParsecT String Integer (State PState) (PVar String)
forall u a. ParserT u a -> ParserT u a
parens ParsecT String Integer (State PState) (PVar String)
forall t. IsString t => Parser (PVar t)
predVarUseP)
  Parser Predicate -> Parser Predicate -> Parser Predicate
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (PVar String -> Predicate
forall t. PVar t -> Predicate
pdVar (PVar String -> Predicate)
-> ParsecT String Integer (State PState) (PVar String)
-> Parser Predicate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>        ParsecT String Integer (State PState) (PVar String)
forall t. IsString t => Parser (PVar t)
predVarUseP)
  Parser Predicate -> String -> Parser Predicate
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"monoPredicate1P"

predVarUseP :: IsString t
            => Parser (PVar t)
predVarUseP :: Parser (PVar t)
predVarUseP
  = do (Symbol
p, ListNE Expr
xs) <- Parser (Symbol, ListNE Expr)
funArgsP
       PVar t -> Parser (PVar t)
forall (m :: * -> *) a. Monad m => a -> m a
return   (PVar t -> Parser (PVar t)) -> PVar t -> Parser (PVar t)
forall a b. (a -> b) -> a -> b
$ Symbol -> PVKind t -> Symbol -> [(t, Symbol, Expr)] -> PVar t
forall t.
Symbol -> PVKind t -> Symbol -> [(t, Symbol, Expr)] -> PVar t
PV Symbol
p (t -> PVKind t
forall t. t -> PVKind t
PVProp t
forall a. IsString a => a
dummyTyId) Symbol
dummySymbol [ (t
forall a. IsString a => a
dummyTyId, Symbol
dummySymbol, Expr
x) | Expr
x <- ListNE Expr
xs ]

funArgsP :: Parser (Symbol, [Expr])
funArgsP :: Parser (Symbol, ListNE Expr)
funArgsP  = Parser (Symbol, ListNE Expr) -> Parser (Symbol, ListNE Expr)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser (Symbol, ListNE Expr)
realP Parser (Symbol, ListNE Expr)
-> Parser (Symbol, ListNE Expr) -> Parser (Symbol, ListNE Expr)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (Symbol, ListNE Expr)
forall a. ParsecT String Integer (State PState) (Symbol, [a])
empP Parser (Symbol, ListNE Expr)
-> String -> Parser (Symbol, ListNE Expr)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"funArgsP"
  where
    empP :: ParsecT String Integer (State PState) (Symbol, [a])
empP  = (,[]) (Symbol -> (Symbol, [a]))
-> Parser Symbol
-> ParsecT String Integer (State PState) (Symbol, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
predVarIdP
    realP :: Parser (Symbol, ListNE Expr)
realP = do (EVar Symbol
lp, ListNE Expr
xs) <- Expr -> (Expr, ListNE Expr)
splitEApp (Expr -> (Expr, ListNE Expr))
-> Parser Expr
-> ParsecT String Integer (State PState) (Expr, ListNE Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr
funAppP
               (Symbol, ListNE Expr) -> Parser (Symbol, ListNE Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Symbol
lp, ListNE Expr
xs)

boundP :: Parser (Bound (Located BareType) Expr)
boundP :: Parser (Bound (Located BareType) Expr)
boundP = do
  LocSymbol
name   <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
upperIdP
  String -> Parser ()
reservedOp String
"="
  [Located BareType]
vs     <- ParsecT String Integer (State PState) [Located BareType]
forall r c.
Monoid r =>
ParsecT String Integer (State PState) [Located (RType c BTyVar r)]
bvsP
  [(LocSymbol, Located BareType)]
params <- ParsecT String Integer (State PState) (LocSymbol, Located BareType)
-> ParsecT
     String Integer (State PState) [(LocSymbol, Located BareType)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String Integer (State PState) (LocSymbol, Located BareType)
-> ParsecT
     String Integer (State PState) (LocSymbol, Located BareType)
forall u a. ParserT u a -> ParserT u a
parens ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP)
  [(LocSymbol, Located BareType)]
args   <- ParsecT
  String Integer (State PState) [(LocSymbol, Located BareType)]
bargsP
  Expr
body   <- Parser Expr
predP
  Bound (Located BareType) Expr
-> Parser (Bound (Located BareType) Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bound (Located BareType) Expr
 -> Parser (Bound (Located BareType) Expr))
-> Bound (Located BareType) Expr
-> Parser (Bound (Located BareType) Expr)
forall a b. (a -> b) -> a -> b
$ LocSymbol
-> [Located BareType]
-> [(LocSymbol, Located BareType)]
-> [(LocSymbol, Located BareType)]
-> Expr
-> Bound (Located BareType) Expr
forall t e.
LocSymbol
-> [t] -> [(LocSymbol, t)] -> [(LocSymbol, t)] -> e -> Bound t e
Bound LocSymbol
name [Located BareType]
vs [(LocSymbol, Located BareType)]
params [(LocSymbol, Located BareType)]
args Expr
body
 where
    bargsP :: ParsecT
  String Integer (State PState) [(LocSymbol, Located BareType)]
bargsP =     ( do String -> Parser ()
reservedOp String
"\\"
                      [(LocSymbol, Located BareType)]
xs <- ParsecT String Integer (State PState) (LocSymbol, Located BareType)
-> ParsecT
     String Integer (State PState) [(LocSymbol, Located BareType)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String Integer (State PState) (LocSymbol, Located BareType)
-> ParsecT
     String Integer (State PState) (LocSymbol, Located BareType)
forall u a. ParserT u a -> ParserT u a
parens ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP)
                      String -> Parser ()
reservedOp  String
"->"
                      [(LocSymbol, Located BareType)]
-> ParsecT
     String Integer (State PState) [(LocSymbol, Located BareType)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(LocSymbol, Located BareType)]
xs
                 )
           ParsecT
  String Integer (State PState) [(LocSymbol, Located BareType)]
-> ParsecT
     String Integer (State PState) [(LocSymbol, Located BareType)]
-> ParsecT
     String Integer (State PState) [(LocSymbol, Located BareType)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [(LocSymbol, Located BareType)]
-> ParsecT
     String Integer (State PState) [(LocSymbol, Located BareType)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
           ParsecT
  String Integer (State PState) [(LocSymbol, Located BareType)]
-> String
-> ParsecT
     String Integer (State PState) [(LocSymbol, Located BareType)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"bargsP"
    bvsP :: ParsecT String Integer (State PState) [Located (RType c BTyVar r)]
bvsP   =     ( do String -> Parser ()
reserved String
"forall"
                      [Located BTyVar]
xs <- ParsecT String Integer (State PState) (Located BTyVar)
-> ParsecT String Integer (State PState) [Located BTyVar]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String Integer (State PState) BTyVar
-> ParsecT String Integer (State PState) (Located BTyVar)
forall a. Parser a -> Parser (Located a)
locParserP (Symbol -> BTyVar
bTyVar (Symbol -> BTyVar)
-> Parser Symbol -> ParsecT String Integer (State PState) BTyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
symbolP))
                      String -> Parser ()
reservedOp  String
"."
                      [Located (RType c BTyVar r)]
-> ParsecT
     String Integer (State PState) [Located (RType c BTyVar r)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((BTyVar -> RType c BTyVar r)
-> Located BTyVar -> Located (RType c BTyVar r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BTyVar -> r -> RType c BTyVar r
forall c tv r. tv -> r -> RType c tv r
`RVar` r
forall a. Monoid a => a
mempty) (Located BTyVar -> Located (RType c BTyVar r))
-> [Located BTyVar] -> [Located (RType c BTyVar r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Located BTyVar]
xs)
                 )
           ParsecT String Integer (State PState) [Located (RType c BTyVar r)]
-> ParsecT
     String Integer (State PState) [Located (RType c BTyVar r)]
-> ParsecT
     String Integer (State PState) [Located (RType c BTyVar r)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Located (RType c BTyVar r)]
-> ParsecT
     String Integer (State PState) [Located (RType c BTyVar r)]
forall (m :: * -> *) a. Monad m => a -> m a
return []


infixGenP :: Assoc -> Parser ()
infixGenP :: Assoc -> Parser ()
infixGenP Assoc
assoc = do
   Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
   Maybe Line
p <- Parser (Maybe Line)
maybeDigit
   Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
   String
s <- Parser String
infixIdP
   Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
   Fixity -> Parser ()
addOperatorP (Maybe Line
-> String -> Maybe (Expr -> Expr -> Expr) -> Assoc -> Fixity
FInfix Maybe Line
p String
s Maybe (Expr -> Expr -> Expr)
forall a. Maybe a
Nothing Assoc
assoc)


infixP :: Parser ()
infixP :: Parser ()
infixP = Assoc -> Parser ()
infixGenP Assoc
AssocLeft

infixlP :: Parser ()
infixlP :: Parser ()
infixlP = Assoc -> Parser ()
infixGenP Assoc
AssocLeft

infixrP :: Parser ()
infixrP :: Parser ()
infixrP = Assoc -> Parser ()
infixGenP Assoc
AssocRight

maybeDigit :: Parser (Maybe Int)
maybeDigit :: Parser (Maybe Line)
maybeDigit
  = Parser (Maybe Line) -> Parser (Maybe Line)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((Char -> Bool) -> ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDigit ParsecT String Integer (State PState) Char
-> (Char -> Parser (Maybe Line)) -> Parser (Maybe Line)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Line -> Parser (Maybe Line)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Line -> Parser (Maybe Line))
-> (Char -> Maybe Line) -> Char -> Parser (Maybe Line)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Maybe Line
forall a. a -> Maybe a
Just (Line -> Maybe Line) -> (Char -> Line) -> Char -> Maybe Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Line
forall a. Read a => String -> a
read (String -> Line) -> (Char -> String) -> Char -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ShowS
forall a. a -> [a] -> [a]
:[]))
  Parser (Maybe Line) -> Parser (Maybe Line) -> Parser (Maybe Line)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe Line -> Parser (Maybe Line)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Line
forall a. Maybe a
Nothing

------------------------------------------------------------------------
----------------------- Wrapped Constructors ---------------------------
------------------------------------------------------------------------

bRProp :: [((Symbol, τ), Symbol)]
       -> Expr -> Ref τ (RType c BTyVar (UReft Reft))
bRProp :: [((Symbol, τ), Symbol)] -> Expr -> Ref τ (RType c BTyVar RReft)
bRProp []    Expr
_    = Maybe SrcSpan -> String -> Ref τ (RType c BTyVar RReft)
forall a. Maybe SrcSpan -> String -> a
panic Maybe SrcSpan
forall a. Maybe a
Nothing String
"Parse.bRProp empty list"
bRProp [((Symbol, τ), Symbol)]
syms' Expr
expr = [(Symbol, τ)]
-> RType c BTyVar RReft -> Ref τ (RType c BTyVar RReft)
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp [(Symbol, τ)]
ss (RType c BTyVar RReft -> Ref τ (RType c BTyVar RReft))
-> RType c BTyVar RReft -> Ref τ (RType c BTyVar RReft)
forall a b. (a -> b) -> a -> b
$ BTyVar -> Predicate -> Reft -> RType c BTyVar RReft
forall tv r c. tv -> Predicate -> r -> RType c tv (UReft r)
bRVar (Symbol -> BTyVar
BTV Symbol
dummyName) Predicate
forall a. Monoid a => a
mempty Reft
r
  where
    ([(Symbol, τ)]
ss, (Symbol
v, τ
_))  = ([(Symbol, τ)] -> [(Symbol, τ)]
forall a. [a] -> [a]
init [(Symbol, τ)]
syms, [(Symbol, τ)] -> (Symbol, τ)
forall a. [a] -> a
last [(Symbol, τ)]
syms)
    syms :: [(Symbol, τ)]
syms          = [(Symbol
y, τ
s) | ((Symbol
_, τ
s), Symbol
y) <- [((Symbol, τ), Symbol)]
syms']
    su :: Subst
su            = [(Symbol, Expr)] -> Subst
mkSubst [(Symbol
x, Symbol -> Expr
EVar Symbol
y) | ((Symbol
x, τ
_), Symbol
y) <- [((Symbol, τ), Symbol)]
syms']
    r :: Reft
r             = Subst
su Subst -> Reft -> Reft
forall a. Subable a => Subst -> a -> a
`subst` (Symbol, Expr) -> Reft
Reft (Symbol
v, Expr
expr)

bRVar :: tv -> Predicate -> r -> RType c tv (UReft r)
bRVar :: tv -> Predicate -> r -> RType c tv (UReft r)
bRVar tv
α Predicate
p r
r = tv -> UReft r -> RType c tv (UReft r)
forall c tv r. tv -> r -> RType c tv r
RVar tv
α (r -> Predicate -> UReft r
forall r. r -> Predicate -> UReft r
MkUReft r
r Predicate
p)

bLst :: Maybe (RType BTyCon tv (UReft r))
     -> [RTProp BTyCon tv (UReft r)]
     -> r
     -> RType BTyCon tv (UReft r)
bLst :: Maybe (RType BTyCon tv (UReft r))
-> [RTProp BTyCon tv (UReft r)] -> r -> RType BTyCon tv (UReft r)
bLst (Just RType BTyCon tv (UReft r)
t) [RTProp BTyCon tv (UReft r)]
rs r
r        = BTyCon
-> [RType BTyCon tv (UReft r)]
-> [RTProp BTyCon tv (UReft r)]
-> UReft r
-> RType BTyCon tv (UReft r)
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp (LocSymbol -> BTyCon
mkBTyCon (LocSymbol -> BTyCon) -> LocSymbol -> BTyCon
forall a b. (a -> b) -> a -> b
$ Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc Symbol
listConName) [RType BTyCon tv (UReft r)
t] [RTProp BTyCon tv (UReft r)]
rs (r -> UReft r
forall r. r -> UReft r
reftUReft r
r)
bLst (Maybe (RType BTyCon tv (UReft r))
Nothing) [RTProp BTyCon tv (UReft r)]
rs r
r       = BTyCon
-> [RType BTyCon tv (UReft r)]
-> [RTProp BTyCon tv (UReft r)]
-> UReft r
-> RType BTyCon tv (UReft r)
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp (LocSymbol -> BTyCon
mkBTyCon (LocSymbol -> BTyCon) -> LocSymbol -> BTyCon
forall a b. (a -> b) -> a -> b
$ Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc Symbol
listConName) []  [RTProp BTyCon tv (UReft r)]
rs (r -> UReft r
forall r. r -> UReft r
reftUReft r
r)

bTup :: (PPrint r, Reftable r, Reftable (RType BTyCon BTyVar (UReft r)), Reftable (RTProp BTyCon BTyVar (UReft r)))
     => [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
     -> [RTProp BTyCon BTyVar (UReft r)]
     -> r
     -> RType BTyCon BTyVar (UReft r)
bTup :: [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
-> [RTProp BTyCon BTyVar (UReft r)]
-> r
-> RType BTyCon BTyVar (UReft r)
bTup [(Maybe Symbol
_,RType BTyCon BTyVar (UReft r)
t)] [RTProp BTyCon BTyVar (UReft r)]
_ r
r
  | r -> Bool
forall r. Reftable r => r -> Bool
isTauto r
r  = RType BTyCon BTyVar (UReft r)
t
  | Bool
otherwise  = RType BTyCon BTyVar (UReft r)
t RType BTyCon BTyVar (UReft r)
-> UReft r -> RType BTyCon BTyVar (UReft r)
forall r c tv. Reftable r => RType c tv r -> r -> RType c tv r
`strengthen` (r -> UReft r
forall r. r -> UReft r
reftUReft r
r)
bTup [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
ts [RTProp BTyCon BTyVar (UReft r)]
rs r
r
  | (Maybe Symbol -> Bool) -> [Maybe Symbol] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe Symbol -> Bool
forall a. Maybe a -> Bool
Mb.isNothing ((Maybe Symbol, RType BTyCon BTyVar (UReft r)) -> Maybe Symbol
forall a b. (a, b) -> a
fst ((Maybe Symbol, RType BTyCon BTyVar (UReft r)) -> Maybe Symbol)
-> [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
-> [Maybe Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
ts) Bool -> Bool -> Bool
|| [(Maybe Symbol, RType BTyCon BTyVar (UReft r))] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
ts Line -> Line -> Bool
forall a. Ord a => a -> a -> Bool
< Line
2
  = BTyCon
-> [RType BTyCon BTyVar (UReft r)]
-> [RTProp BTyCon BTyVar (UReft r)]
-> UReft r
-> RType BTyCon BTyVar (UReft r)
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp (LocSymbol -> BTyCon
mkBTyCon (LocSymbol -> BTyCon) -> LocSymbol -> BTyCon
forall a b. (a -> b) -> a -> b
$ Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc Symbol
tupConName) ((Maybe Symbol, RType BTyCon BTyVar (UReft r))
-> RType BTyCon BTyVar (UReft r)
forall a b. (a, b) -> b
snd ((Maybe Symbol, RType BTyCon BTyVar (UReft r))
 -> RType BTyCon BTyVar (UReft r))
-> [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
-> [RType BTyCon BTyVar (UReft r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
ts) [RTProp BTyCon BTyVar (UReft r)]
rs (r -> UReft r
forall r. r -> UReft r
reftUReft r
r)
  | Bool
otherwise
  = BTyCon
-> [RType BTyCon BTyVar (UReft r)]
-> [RTProp BTyCon BTyVar (UReft r)]
-> UReft r
-> RType BTyCon BTyVar (UReft r)
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp (LocSymbol -> BTyCon
mkBTyCon (LocSymbol -> BTyCon) -> LocSymbol -> BTyCon
forall a b. (a -> b) -> a -> b
$ Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc Symbol
tupConName) ((RType BTyCon BTyVar (UReft r) -> RType BTyCon BTyVar (UReft r)
forall r. Reftable r => r -> r
top (RType BTyCon BTyVar (UReft r) -> RType BTyCon BTyVar (UReft r))
-> ((Maybe Symbol, RType BTyCon BTyVar (UReft r))
    -> RType BTyCon BTyVar (UReft r))
-> (Maybe Symbol, RType BTyCon BTyVar (UReft r))
-> RType BTyCon BTyVar (UReft r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Symbol, RType BTyCon BTyVar (UReft r))
-> RType BTyCon BTyVar (UReft r)
forall a b. (a, b) -> b
snd) ((Maybe Symbol, RType BTyCon BTyVar (UReft r))
 -> RType BTyCon BTyVar (UReft r))
-> [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
-> [RType BTyCon BTyVar (UReft r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
ts) [RTProp BTyCon BTyVar (UReft r)]
forall r2.
Monoid r2 =>
[Ref (RType BTyCon BTyVar r2) (RType BTyCon BTyVar (UReft r))]
rs' (r -> UReft r
forall r. r -> UReft r
reftUReft r
r)
  where
    args :: [(Symbol, RType BTyCon BTyVar r2)]
args       = [(Symbol -> Maybe Symbol -> Symbol
forall a. a -> Maybe a -> a
Mb.fromMaybe Symbol
dummySymbol Maybe Symbol
x, (UReft r -> r2)
-> RType BTyCon BTyVar (UReft r) -> RType BTyCon BTyVar r2
forall r1 r2 c tv. (r1 -> r2) -> RType c tv r1 -> RType c tv r2
mapReft UReft r -> r2
forall a. Monoid a => a
mempty RType BTyCon BTyVar (UReft r)
t) | (Maybe Symbol
x,RType BTyCon BTyVar (UReft r)
t) <- [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
ts]
    makeProp :: Line
-> Ref (RType BTyCon BTyVar r2) (RType BTyCon BTyVar (UReft r))
makeProp Line
i = [(Symbol, RType BTyCon BTyVar r2)]
-> RType BTyCon BTyVar (UReft r)
-> Ref (RType BTyCon BTyVar r2) (RType BTyCon BTyVar (UReft r))
forall τ t. [(Symbol, τ)] -> t -> Ref τ t
RProp (Line
-> [(Symbol, RType BTyCon BTyVar r2)]
-> [(Symbol, RType BTyCon BTyVar r2)]
forall a. Line -> [a] -> [a]
take Line
i [(Symbol, RType BTyCon BTyVar r2)]
forall r2. Monoid r2 => [(Symbol, RType BTyCon BTyVar r2)]
args) (((Maybe Symbol, RType BTyCon BTyVar (UReft r))
-> RType BTyCon BTyVar (UReft r)
forall a b. (a, b) -> b
snd ((Maybe Symbol, RType BTyCon BTyVar (UReft r))
 -> RType BTyCon BTyVar (UReft r))
-> [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
-> [RType BTyCon BTyVar (UReft r)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
ts)[RType BTyCon BTyVar (UReft r)]
-> Line -> RType BTyCon BTyVar (UReft r)
forall a. [a] -> Line -> a
!!Line
i)
    rs' :: [Ref (RType BTyCon BTyVar r2) (RType BTyCon BTyVar (UReft r))]
rs'        = Line
-> Ref (RType BTyCon BTyVar r2) (RType BTyCon BTyVar (UReft r))
forall r2.
Monoid r2 =>
Line
-> Ref (RType BTyCon BTyVar r2) (RType BTyCon BTyVar (UReft r))
makeProp (Line
 -> Ref (RType BTyCon BTyVar r2) (RType BTyCon BTyVar (UReft r)))
-> [Line]
-> [Ref (RType BTyCon BTyVar r2) (RType BTyCon BTyVar (UReft r))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Line
1..([(Maybe Symbol, RType BTyCon BTyVar (UReft r))] -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length [(Maybe Symbol, RType BTyCon BTyVar (UReft r))]
tsLine -> Line -> Line
forall a. Num a => a -> a -> a
-Line
1)]


-- Temporarily restore this hack benchmarks/esop2013-submission/Array.hs fails
-- w/o it
-- TODO RApp Int [] [p] true should be syntactically different than RApp Int [] [] p
-- bCon b s [RProp _ (RHole r1)] [] _ r = RApp b [] [] $ r1 `meet` (MkUReft r mempty s)
bCon :: c
     -> [RTProp c tv (UReft r)]
     -> [RType c tv (UReft r)]
     -> Predicate
     -> r
     -> RType c tv (UReft r)
bCon :: c
-> [RTProp c tv (UReft r)]
-> [RType c tv (UReft r)]
-> Predicate
-> r
-> RType c tv (UReft r)
bCon c
b [RTProp c tv (UReft r)]
rs [RType c tv (UReft r)]
ts Predicate
p r
r = c
-> [RType c tv (UReft r)]
-> [RTProp c tv (UReft r)]
-> UReft r
-> RType c tv (UReft r)
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp c
b [RType c tv (UReft r)]
ts [RTProp c tv (UReft r)]
rs (UReft r -> RType c tv (UReft r))
-> UReft r -> RType c tv (UReft r)
forall a b. (a -> b) -> a -> b
$ r -> Predicate -> UReft r
forall r. r -> Predicate -> UReft r
MkUReft r
r Predicate
p

bAppTy :: (Foldable t, PPrint r, Reftable r)
       => tv -> t (RType c tv (UReft r)) -> r -> RType c tv (UReft r)
bAppTy :: tv -> t (RType c tv (UReft r)) -> r -> RType c tv (UReft r)
bAppTy tv
v t (RType c tv (UReft r))
ts r
r  = RType c tv (UReft r)
ts' RType c tv (UReft r) -> UReft r -> RType c tv (UReft r)
forall r c tv. Reftable r => RType c tv r -> r -> RType c tv r
`strengthen` r -> UReft r
forall r. r -> UReft r
reftUReft r
r
  where
    ts' :: RType c tv (UReft r)
ts'        = (RType c tv (UReft r)
 -> RType c tv (UReft r) -> RType c tv (UReft r))
-> RType c tv (UReft r)
-> t (RType c tv (UReft r))
-> RType c tv (UReft r)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\RType c tv (UReft r)
a RType c tv (UReft r)
b -> RType c tv (UReft r)
-> RType c tv (UReft r) -> UReft r -> RType c tv (UReft r)
forall c tv r. RType c tv r -> RType c tv r -> r -> RType c tv r
RAppTy RType c tv (UReft r)
a RType c tv (UReft r)
b UReft r
forall a. Monoid a => a
mempty) (tv -> UReft r -> RType c tv (UReft r)
forall c tv r. tv -> r -> RType c tv r
RVar tv
v UReft r
forall a. Monoid a => a
mempty) t (RType c tv (UReft r))
ts

reftUReft :: r -> UReft r
reftUReft :: r -> UReft r
reftUReft r
r    = r -> Predicate -> UReft r
forall r. r -> Predicate -> UReft r
MkUReft r
r Predicate
forall a. Monoid a => a
mempty

predUReft :: Monoid r => Predicate -> UReft r
predUReft :: Predicate -> UReft r
predUReft Predicate
p    = r -> Predicate -> UReft r
forall r. r -> Predicate -> UReft r
MkUReft r
forall a. Monoid a => a
dummyReft Predicate
p

dummyReft :: Monoid a => a
dummyReft :: a
dummyReft      = a
forall a. Monoid a => a
mempty

dummyTyId :: IsString a => a
dummyTyId :: a
dummyTyId      = a
""

------------------------------------------------------------------
--------------------------- Measures -----------------------------
------------------------------------------------------------------

type BPspec = Pspec LocBareType LocSymbol

-- | The AST for a single parsed spec.
data Pspec ty ctor
  = Meas    (Measure ty ctor)                             -- ^ 'measure' definition
  | Assm    (LocSymbol, ty)                               -- ^ 'assume' signature (unchecked)
  | Asrt    (LocSymbol, ty)                               -- ^ 'assert' signature (checked)
  | LAsrt   (LocSymbol, ty)                               -- ^ 'local' assertion -- RJ: what is this
  | Asrts   ([LocSymbol], (ty, Maybe [Located Expr]))     -- ^ RJ: what is this
  | Impt    Symbol                                        -- ^ 'import' a specification module
  | DDecl   DataDecl                                      -- ^ refined 'data'    declaration 
  | NTDecl  DataDecl                                      -- ^ refined 'newtype' declaration
  | Class   (RClass ty)                                   -- ^ refined 'class' definition
  | CLaws   (RClass ty)                                   -- ^ 'class laws' definition
  | ILaws   (RILaws ty)
  | RInst   (RInstance ty)                                -- ^ refined 'instance' definition
  | Incl    FilePath                                      -- ^ 'include' a path -- TODO: deprecate 
  | Invt    ty                                            -- ^ 'invariant' specification
  | Using  (ty, ty)                                       -- ^ 'using' declaration (for local invariants on a type) 
  | Alias   (Located (RTAlias Symbol BareType))           -- ^ 'type' alias declaration  
  | EAlias  (Located (RTAlias Symbol Expr))               -- ^ 'predicate' alias declaration
  | Embed   (LocSymbol, FTycon, TCArgs)                   -- ^ 'embed' declaration
  | Qualif  Qualifier                                     -- ^ 'qualif' definition
  | Decr    (LocSymbol, [Int])                            -- ^ 'decreasing' annotation -- TODO: deprecate
  | LVars   LocSymbol                                     -- ^ 'lazyvar' annotation, defer checks to *use* sites
  | Lazy    LocSymbol                                     -- ^ 'lazy' annotation, skip termination check on binder
  | Fail    LocSymbol                                     -- ^ 'fail' annotation, the binder should be unsafe
  | Rewrite LocSymbol                                     -- ^ 'rewrite' annotation, the binder generates a rewrite rule
  | Rewritewith (LocSymbol,[LocSymbol])                     -- ^ 'rewritewith' annotation, the first binder is using the rewrite rules of the second list
  | Insts   (LocSymbol, Maybe Int)                        -- ^ 'auto-inst' or 'ple' annotation; use ple locally on binder 
  | HMeas   LocSymbol                                     -- ^ 'measure' annotation; lift Haskell binder as measure
  | Reflect LocSymbol                                     -- ^ 'reflect' annotation; reflect Haskell binder as function in logic
  | Inline  LocSymbol                                     -- ^ 'inline' annotation;  inline (non-recursive) binder as an alias
  | Ignore  LocSymbol                                     -- ^ 'ignore' annotation; skip all checks inside this binder
  | ASize   LocSymbol                                     -- ^ 'autosize' annotation; automatically generate size metric for this type
  | HBound  LocSymbol                                     -- ^ 'bound' annotation; lift Haskell binder as an abstract-refinement "bound"
  | PBound  (Bound ty Expr)                               -- ^ 'bound' definition
  | Pragma  (Located String)                              -- ^ 'LIQUID' pragma, used to save configuration options in source files
  | CMeas   (Measure ty ())                               -- ^ 'class measure' definition
  | IMeas   (Measure ty ctor)                             -- ^ 'instance measure' definition
  | Varia   (LocSymbol, [Variance])                       -- ^ 'variance' annotations, marking type constructor params as co-, contra-, or in-variant
  | BFix    ()                                            -- ^ fixity annotation
  | Define  (LocSymbol, Symbol)                           -- ^ 'define' annotation for specifying aliases c.f. `include-CoreToLogic.lg`
  deriving (Typeable (Pspec ty ctor)
DataType
Constr
Typeable (Pspec ty ctor)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pspec ty ctor -> c (Pspec ty ctor))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Pspec ty ctor))
-> (Pspec ty ctor -> Constr)
-> (Pspec ty ctor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Pspec ty ctor)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Pspec ty ctor)))
-> ((forall b. Data b => b -> b) -> Pspec ty ctor -> Pspec ty ctor)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pspec ty ctor -> [u])
-> (forall u.
    Line -> (forall d. Data d => d -> u) -> Pspec ty ctor -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Pspec ty ctor -> m (Pspec ty ctor))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Pspec ty ctor -> m (Pspec ty ctor))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Pspec ty ctor -> m (Pspec ty ctor))
-> Data (Pspec ty ctor)
Pspec ty ctor -> DataType
Pspec ty ctor -> Constr
(forall b. Data b => b -> b) -> Pspec ty ctor -> Pspec ty ctor
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pspec ty ctor -> c (Pspec ty ctor)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pspec ty ctor)
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Pspec ty ctor))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Line -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Line -> (forall d. Data d => d -> u) -> Pspec ty ctor -> u
forall u. (forall d. Data d => d -> u) -> Pspec ty ctor -> [u]
forall ty ctor. (Data ty, Data ctor) => Typeable (Pspec ty ctor)
forall ty ctor. (Data ty, Data ctor) => Pspec ty ctor -> DataType
forall ty ctor. (Data ty, Data ctor) => Pspec ty ctor -> Constr
forall ty ctor.
(Data ty, Data ctor) =>
(forall b. Data b => b -> b) -> Pspec ty ctor -> Pspec ty ctor
forall ty ctor u.
(Data ty, Data ctor) =>
Line -> (forall d. Data d => d -> u) -> Pspec ty ctor -> u
forall ty ctor u.
(Data ty, Data ctor) =>
(forall d. Data d => d -> u) -> Pspec ty ctor -> [u]
forall ty ctor r r'.
(Data ty, Data ctor) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r
forall ty ctor r r'.
(Data ty, Data ctor) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r
forall ty ctor (m :: * -> *).
(Data ty, Data ctor, Monad m) =>
(forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
forall ty ctor (m :: * -> *).
(Data ty, Data ctor, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
forall ty ctor (c :: * -> *).
(Data ty, Data ctor) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pspec ty ctor)
forall ty ctor (c :: * -> *).
(Data ty, Data ctor) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pspec ty ctor -> c (Pspec ty ctor)
forall ty ctor (t :: * -> *) (c :: * -> *).
(Data ty, Data ctor, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Pspec ty ctor))
forall ty ctor (t :: * -> * -> *) (c :: * -> *).
(Data ty, Data ctor, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Pspec ty ctor))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pspec ty ctor)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pspec ty ctor -> c (Pspec ty ctor)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Pspec ty ctor))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Pspec ty ctor))
$cDefine :: Constr
$cBFix :: Constr
$cVaria :: Constr
$cIMeas :: Constr
$cCMeas :: Constr
$cPragma :: Constr
$cPBound :: Constr
$cHBound :: Constr
$cASize :: Constr
$cIgnore :: Constr
$cInline :: Constr
$cReflect :: Constr
$cHMeas :: Constr
$cInsts :: Constr
$cRewritewith :: Constr
$cRewrite :: Constr
$cFail :: Constr
$cLazy :: Constr
$cLVars :: Constr
$cDecr :: Constr
$cQualif :: Constr
$cEmbed :: Constr
$cEAlias :: Constr
$cAlias :: Constr
$cUsing :: Constr
$cInvt :: Constr
$cIncl :: Constr
$cRInst :: Constr
$cILaws :: Constr
$cCLaws :: Constr
$cClass :: Constr
$cNTDecl :: Constr
$cDDecl :: Constr
$cImpt :: Constr
$cAsrts :: Constr
$cLAsrt :: Constr
$cAsrt :: Constr
$cAssm :: Constr
$cMeas :: Constr
$tPspec :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
$cgmapMo :: forall ty ctor (m :: * -> *).
(Data ty, Data ctor, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
gmapMp :: (forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
$cgmapMp :: forall ty ctor (m :: * -> *).
(Data ty, Data ctor, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
gmapM :: (forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
$cgmapM :: forall ty ctor (m :: * -> *).
(Data ty, Data ctor, Monad m) =>
(forall d. Data d => d -> m d)
-> Pspec ty ctor -> m (Pspec ty ctor)
gmapQi :: Line -> (forall d. Data d => d -> u) -> Pspec ty ctor -> u
$cgmapQi :: forall ty ctor u.
(Data ty, Data ctor) =>
Line -> (forall d. Data d => d -> u) -> Pspec ty ctor -> u
gmapQ :: (forall d. Data d => d -> u) -> Pspec ty ctor -> [u]
$cgmapQ :: forall ty ctor u.
(Data ty, Data ctor) =>
(forall d. Data d => d -> u) -> Pspec ty ctor -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r
$cgmapQr :: forall ty ctor r r'.
(Data ty, Data ctor) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r
$cgmapQl :: forall ty ctor r r'.
(Data ty, Data ctor) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Pspec ty ctor -> r
gmapT :: (forall b. Data b => b -> b) -> Pspec ty ctor -> Pspec ty ctor
$cgmapT :: forall ty ctor.
(Data ty, Data ctor) =>
(forall b. Data b => b -> b) -> Pspec ty ctor -> Pspec ty ctor
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Pspec ty ctor))
$cdataCast2 :: forall ty ctor (t :: * -> * -> *) (c :: * -> *).
(Data ty, Data ctor, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Pspec ty ctor))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Pspec ty ctor))
$cdataCast1 :: forall ty ctor (t :: * -> *) (c :: * -> *).
(Data ty, Data ctor, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Pspec ty ctor))
dataTypeOf :: Pspec ty ctor -> DataType
$cdataTypeOf :: forall ty ctor. (Data ty, Data ctor) => Pspec ty ctor -> DataType
toConstr :: Pspec ty ctor -> Constr
$ctoConstr :: forall ty ctor. (Data ty, Data ctor) => Pspec ty ctor -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pspec ty ctor)
$cgunfold :: forall ty ctor (c :: * -> *).
(Data ty, Data ctor) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Pspec ty ctor)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pspec ty ctor -> c (Pspec ty ctor)
$cgfoldl :: forall ty ctor (c :: * -> *).
(Data ty, Data ctor) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pspec ty ctor -> c (Pspec ty ctor)
$cp1Data :: forall ty ctor. (Data ty, Data ctor) => Typeable (Pspec ty ctor)
Data, Typeable)

instance (PPrint ty, PPrint ctor) => PPrint (Pspec ty ctor) where 
  pprintTidy :: Tidy -> Pspec ty ctor -> Doc
pprintTidy = Tidy -> Pspec ty ctor -> Doc
forall ty ctor.
(PPrint ty, PPrint ctor) =>
Tidy -> Pspec ty ctor -> Doc
ppPspec 

splice :: PJ.Doc -> [PJ.Doc] -> PJ.Doc
splice :: Doc -> [Doc] -> Doc
splice Doc
sep = [Doc] -> Doc
PJ.hcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
PJ.punctuate Doc
sep

ppAsserts :: (PPrint t) => Tidy -> [LocSymbol] -> t -> Maybe [Located Expr] -> PJ.Doc
ppAsserts :: Tidy -> [LocSymbol] -> t -> Maybe [Located Expr] -> Doc
ppAsserts Tidy
k [LocSymbol]
lxs t
t Maybe [Located Expr]
les 
  = [Doc] -> Doc
PJ.hcat [ Doc -> [Doc] -> Doc
splice Doc
", " (Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (Symbol -> Doc) -> [Symbol] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LocSymbol -> Symbol
forall a. Located a -> a
val (LocSymbol -> Symbol) -> [LocSymbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocSymbol]
lxs))
            , Doc
" :: " 
            , Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t   
            , Maybe [Located Expr] -> Doc
forall (f :: * -> *) b.
(PPrint (f b), Functor f) =>
Maybe (f (Located b)) -> Doc
ppLes Maybe [Located Expr]
les 
            ]
  where 
    ppLes :: Maybe (f (Located b)) -> Doc
ppLes Maybe (f (Located b))
Nothing    = Doc
""
    ppLes (Just f (Located b)
les) = Doc
"/" Doc -> Doc -> Doc
<+> Tidy -> f b -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (Located b -> b
forall a. Located a -> a
val (Located b -> b) -> f (Located b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Located b)
les)

ppPspec :: (PPrint t, PPrint c) => Tidy -> Pspec t c -> PJ.Doc
ppPspec :: Tidy -> Pspec t c -> Doc
ppPspec Tidy
k (Meas Measure t c
m)        
  = Doc
"measure" Doc -> Doc -> Doc
<+> Tidy -> Measure t c -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k Measure t c
m 
ppPspec Tidy
k (Assm (LocSymbol
lx, t
t))  
  = Doc
"assume"  Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) Doc -> Doc -> Doc
<+> Doc
"::" Doc -> Doc -> Doc
<+> Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t 
ppPspec Tidy
k (Asrt (LocSymbol
lx, t
t))  
  = Doc
"assert"  Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) Doc -> Doc -> Doc
<+> Doc
"::" Doc -> Doc -> Doc
<+> Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t 
ppPspec Tidy
k (LAsrt (LocSymbol
lx, t
t)) 
  = Doc
"local assert"  Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) Doc -> Doc -> Doc
<+> Doc
"::" Doc -> Doc -> Doc
<+> Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t 
ppPspec Tidy
k (Asrts ([LocSymbol]
lxs, (t
t, Maybe [Located Expr]
les))) 
  = Tidy -> [LocSymbol] -> t -> Maybe [Located Expr] -> Doc
forall t.
PPrint t =>
Tidy -> [LocSymbol] -> t -> Maybe [Located Expr] -> Doc
ppAsserts Tidy
k [LocSymbol]
lxs t
t Maybe [Located Expr]
les
ppPspec Tidy
k (Impt  Symbol
x) 
  = Doc
"import" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k Symbol
x 
ppPspec Tidy
k (DDecl DataDecl
d) 
  = Tidy -> DataDecl -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k DataDecl
d 
ppPspec Tidy
k (NTDecl DataDecl
d) 
  = Doc
"newtype" Doc -> Doc -> Doc
<+> Tidy -> DataDecl -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k DataDecl
d 
ppPspec Tidy
_ (Incl String
f) 
  = Doc
"include" Doc -> Doc -> Doc
<+> Doc
"<" Doc -> Doc -> Doc
PJ.<> String -> Doc
PJ.text String
f Doc -> Doc -> Doc
PJ.<> Doc
">"
ppPspec Tidy
k (Invt t
t)
  = Doc
"invariant" Doc -> Doc -> Doc
<+> Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t 
ppPspec Tidy
k (Using (t
t1, t
t2)) 
  = Doc
"using" Doc -> Doc -> Doc
<+> Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t1 Doc -> Doc -> Doc
<+> Doc
"as" Doc -> Doc -> Doc
<+> Tidy -> t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k t
t2
ppPspec Tidy
k (Alias   (Loc SourcePos
_ SourcePos
_ RTAlias Symbol BareType
rta)) 
  = Doc
"type" Doc -> Doc -> Doc
<+> Tidy -> RTAlias Symbol BareType -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k RTAlias Symbol BareType
rta 
ppPspec Tidy
k (EAlias  (Loc SourcePos
_ SourcePos
_ RTAlias Symbol Expr
rte)) 
  = Doc
"predicate" Doc -> Doc -> Doc
<+> Tidy -> RTAlias Symbol Expr -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k RTAlias Symbol Expr
rte 
ppPspec Tidy
k (Embed   (LocSymbol
lx, FTycon
tc, TCArgs
NoArgs)) 
  = Doc
"embed" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx)         Doc -> Doc -> Doc
<+> Doc
"as" Doc -> Doc -> Doc
<+> Tidy -> FTycon -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k FTycon
tc 
ppPspec Tidy
k (Embed   (LocSymbol
lx, FTycon
tc, TCArgs
WithArgs)) 
  = Doc
"embed" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) Doc -> Doc -> Doc
<+> Doc
"*" Doc -> Doc -> Doc
<+> Doc
"as" Doc -> Doc -> Doc
<+> Tidy -> FTycon -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k FTycon
tc 
ppPspec Tidy
k (Qualif  Qualifier
q)              
  = Tidy -> Qualifier -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k Qualifier
q 
ppPspec Tidy
k (Decr (LocSymbol
lx, [Line]
ns))        
  = Doc
"decreasing" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) Doc -> Doc -> Doc
<+> Tidy -> [Line] -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k [Line]
ns
ppPspec Tidy
k (LVars   LocSymbol
lx) 
  = Doc
"lazyvar" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (Lazy   LocSymbol
lx) 
  = Doc
"lazy" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (Rewrite   LocSymbol
lx) 
  = Doc
"rewrite" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (Rewritewith (LocSymbol
lx, [LocSymbol]
lxs)) 
  = Doc
"rewriteWith" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) Doc -> Doc -> Doc
<+> Tidy -> [Symbol] -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val (LocSymbol -> Symbol) -> [LocSymbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocSymbol]
lxs) 
ppPspec Tidy
k (Fail   LocSymbol
lx) 
  = Doc
"fail" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (Insts   (LocSymbol
lx, Maybe Line
mbN)) 
  = Doc
"automatic-instances" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) Doc -> Doc -> Doc
<+> Doc -> (Line -> Doc) -> Maybe Line -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
"" ((Doc
"with" Doc -> Doc -> Doc
<+>) (Doc -> Doc) -> (Line -> Doc) -> Line -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tidy -> Line -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k) Maybe Line
mbN 
ppPspec Tidy
k (HMeas   LocSymbol
lx) 
  = Doc
"measure" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (Reflect LocSymbol
lx) 
  = Doc
"reflect" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (Inline  LocSymbol
lx) 
  = Doc
"inline" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (Ignore  LocSymbol
lx) 
  = Doc
"ignore" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (HBound  LocSymbol
lx) 
  = Doc
"bound" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (ASize   LocSymbol
lx) 
  = Doc
"autosize" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) 
ppPspec Tidy
k (PBound  Bound t Expr
bnd) 
  = Tidy -> Bound t Expr -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k Bound t Expr
bnd 
ppPspec Tidy
_ (Pragma  (Loc SourcePos
_ SourcePos
_ String
s)) 
  = Doc
"LIQUID" Doc -> Doc -> Doc
<+> String -> Doc
PJ.text String
s 
ppPspec Tidy
k (CMeas   Measure t ()
m) 
  = Doc
"class measure" Doc -> Doc -> Doc
<+> Tidy -> Measure t () -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k Measure t ()
m
ppPspec Tidy
k (IMeas   Measure t c
m) 
  = Doc
"instance  measure" Doc -> Doc -> Doc
<+> Tidy -> Measure t c -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k Measure t c
m
ppPspec Tidy
k (Class   RClass t
cls) 
  = Tidy -> RClass t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k RClass t
cls 
ppPspec Tidy
k (CLaws  RClass t
cls) 
  = Tidy -> RClass t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k RClass t
cls 
ppPspec Tidy
k (RInst   RInstance t
inst) 
  = Tidy -> RInstance t -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k RInstance t
inst 
ppPspec Tidy
k (Varia   (LocSymbol
lx, [Variance]
vs))  
  = Doc
"data variance" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) Doc -> Doc -> Doc
<+> Doc -> [Doc] -> Doc
splice Doc
" " (Tidy -> Variance -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (Variance -> Doc) -> [Variance] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Variance]
vs) 
ppPspec Tidy
_ (BFix    ()
_)           -- 
  = Doc
"fixity"
ppPspec Tidy
k (Define  (LocSymbol
lx, Symbol
y))     
  = Doc
"define" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
lx) Doc -> Doc -> Doc
<+> Doc
"=" Doc -> Doc -> Doc
<+> Tidy -> Symbol -> Doc
forall a. PPrint a => Tidy -> a -> Doc
pprintTidy Tidy
k Symbol
y 
ppPspec Tidy
_ (ILaws {}) 
  = Doc
"TBD-INSTANCE-LAWS"


-- | For debugging
{-instance Show (Pspec a b) where
  show (Meas   _) = "Meas"
  show (Assm   _) = "Assm"
  show (Asrt   _) = "Asrt"
  show (LAsrt  _) = "LAsrt"
  show (Asrts  _) = "Asrts"
  show (Impt   _) = "Impt"
  shcl  _) = "DDecl"
  show (NTDecl _) = "NTDecl"
  show (Incl   _) = "Incl"
  show (Invt   _) = "Invt"
  show (Using _) = "Using"
  show (Alias  _) = "Alias"
  show (EAlias _) = "EAlias"
  show (Embed  _) = "Embed"
  show (Qualif _) = "Qualif"
  show (Decr   _) = "Decr"
  show (LVars  _) = "LVars"
  show (Lazy   _) = "Lazy"
  -- show (Axiom  _) = "Axiom"
  show (Insts  _) = "Insts"
  show (Reflect _) = "Reflect"
  show (HMeas  _) = "HMeas"
  show (HBound _) = "HBound"
  show (Inline _) = "Inline"
  show (Pragma _) = "Pragma"
  show (CMeas  _) = "CMeas"
  show (IMeas  _) = "IMeas"
  show (Class  _) = "Class"
  show (Varia  _) = "Varia"
  show (PBound _) = "Bound"
  show (RInst  _) = "RInst"
  show (ASize  _) = "ASize"
  show (BFix   _) = "BFix"
  show (Define _) = "Define"-}

qualifySpec :: Symbol -> Spec ty bndr -> Spec ty bndr
qualifySpec :: Symbol -> Spec ty bndr -> Spec ty bndr
qualifySpec Symbol
name Spec ty bndr
sp = Spec ty bndr
sp { sigs :: [(LocSymbol, ty)]
sigs      = [ (LocSymbol -> LocSymbol
tx LocSymbol
x, ty
t)  | (LocSymbol
x, ty
t)  <- Spec ty bndr -> [(LocSymbol, ty)]
forall ty bndr. Spec ty bndr -> [(LocSymbol, ty)]
sigs Spec ty bndr
sp]
                         -- , asmSigs   = [ (tx x, t)  | (x, t)  <- asmSigs sp]
                         }
  where
    tx :: Located Symbol -> Located Symbol
    tx :: LocSymbol -> LocSymbol
tx = (Symbol -> Symbol) -> LocSymbol -> LocSymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Symbol -> Symbol -> Symbol
qualifySymbol Symbol
name)

-- | Turns a list of parsed specifications into a "bare spec".
--
-- This is primarily a rearrangement, as the bare spec is a record containing
-- different kinds of spec directives in different positions, whereas the input
-- list is a mixed list.
--
-- In addition, the sigs of the spec (these are asserted/checked LH type
-- signatues) are being qualified, i.e., the binding occurrences are prefixed
-- with the module name.
--
-- Andres: It is unfortunately totally unclear to me what the justification
-- for the qualification is, and in particular, why it is being done for
-- the asserted signatures only. My trust is not exactly improved by the
-- commented out line in 'qualifySpec'.
--
mkSpec :: ModName -> [BPspec] -> (ModName, Measure.Spec LocBareType LocSymbol)
mkSpec :: ModName -> [BPspec] -> (ModName, BareSpec)
mkSpec ModName
name [BPspec]
xs         = (ModName
name,) (BareSpec -> (ModName, BareSpec))
-> BareSpec -> (ModName, BareSpec)
forall a b. (a -> b) -> a -> b
$ Symbol -> BareSpec -> BareSpec
forall ty bndr. Symbol -> Spec ty bndr -> Spec ty bndr
qualifySpec (ModName -> Symbol
forall a. Symbolic a => a -> Symbol
symbol ModName
name) Spec :: forall ty bndr.
[Measure ty bndr]
-> [(Symbol, Sort)]
-> [(Symbol, Sort)]
-> [(LocSymbol, ty)]
-> [(LocSymbol, ty)]
-> [(LocSymbol, ty)]
-> [(LocSymbol, ty)]
-> [(Maybe LocSymbol, ty)]
-> [(ty, ty)]
-> [Symbol]
-> [DataDecl]
-> [DataDecl]
-> [String]
-> [Located (RTAlias Symbol BareType)]
-> [Located (RTAlias Symbol Expr)]
-> TCEmb LocSymbol
-> [Qualifier]
-> [(LocSymbol, [Line])]
-> HashSet LocSymbol
-> HashSet LocSymbol
-> HashSet LocSymbol
-> HashMap LocSymbol [LocSymbol]
-> HashSet LocSymbol
-> HashSet LocSymbol
-> HashMap LocSymbol (Maybe Line)
-> HashSet LocSymbol
-> HashSet LocSymbol
-> HashSet LocSymbol
-> HashSet LocSymbol
-> HashSet LocSymbol
-> [Located String]
-> [Measure ty ()]
-> [Measure ty bndr]
-> [RClass ty]
-> [RClass ty]
-> [(LocSymbol, [Located Expr])]
-> [RInstance ty]
-> [RILaws ty]
-> [(LocSymbol, [Variance])]
-> RRBEnv ty
-> HashMap LocSymbol Symbol
-> [Equation]
-> Spec ty bndr
Measure.Spec
  { measures :: [Measure (Located BareType) LocSymbol]
Measure.measures   = [Measure (Located BareType) LocSymbol
m | Meas   Measure (Located BareType) LocSymbol
m <- [BPspec]
xs]
  , asmSigs :: [(LocSymbol, Located BareType)]
Measure.asmSigs    = [(LocSymbol, Located BareType)
a | Assm   (LocSymbol, Located BareType)
a <- [BPspec]
xs]
  , sigs :: [(LocSymbol, Located BareType)]
Measure.sigs       = [(LocSymbol, Located BareType)
a | Asrt   (LocSymbol, Located BareType)
a <- [BPspec]
xs]
                      [(LocSymbol, Located BareType)]
-> [(LocSymbol, Located BareType)]
-> [(LocSymbol, Located BareType)]
forall a. [a] -> [a] -> [a]
++ [(LocSymbol
y, Located BareType
t) | Asrts ([LocSymbol]
ys, (Located BareType
t, Maybe [Located Expr]
_)) <- [BPspec]
xs, LocSymbol
y <- [LocSymbol]
ys]
  , localSigs :: [(LocSymbol, Located BareType)]
Measure.localSigs  = []
  , reflSigs :: [(LocSymbol, Located BareType)]
Measure.reflSigs   = []
  , impSigs :: [(Symbol, Sort)]
Measure.impSigs    = []
  , expSigs :: [(Symbol, Sort)]
Measure.expSigs    = [] 
  , invariants :: [(Maybe LocSymbol, Located BareType)]
Measure.invariants = [(Maybe LocSymbol
forall a. Maybe a
Nothing, Located BareType
t) | Invt   Located BareType
t <- [BPspec]
xs]
  , ialiases :: [(Located BareType, Located BareType)]
Measure.ialiases   = [(Located BareType, Located BareType)
t | Using (Located BareType, Located BareType)
t <- [BPspec]
xs]
  , imports :: [Symbol]
Measure.imports    = [Symbol
i | Impt   Symbol
i <- [BPspec]
xs]
  , dataDecls :: [DataDecl]
Measure.dataDecls  = [DataDecl
d | DDecl  DataDecl
d <- [BPspec]
xs] [DataDecl] -> [DataDecl] -> [DataDecl]
forall a. [a] -> [a] -> [a]
++ [DataDecl
d | NTDecl DataDecl
d <- [BPspec]
xs]
  , newtyDecls :: [DataDecl]
Measure.newtyDecls = [DataDecl
d | NTDecl DataDecl
d <- [BPspec]
xs]
  , includes :: [String]
Measure.includes   = [String
q | Incl   String
q <- [BPspec]
xs]
  , aliases :: [Located (RTAlias Symbol BareType)]
Measure.aliases    = [Located (RTAlias Symbol BareType)
a | Alias  Located (RTAlias Symbol BareType)
a <- [BPspec]
xs]
  , ealiases :: [Located (RTAlias Symbol Expr)]
Measure.ealiases   = [Located (RTAlias Symbol Expr)
e | EAlias Located (RTAlias Symbol Expr)
e <- [BPspec]
xs]
  , embeds :: TCEmb LocSymbol
Measure.embeds     = [(LocSymbol, (Sort, TCArgs))] -> TCEmb LocSymbol
forall a. (Eq a, Hashable a) => [(a, (Sort, TCArgs))] -> TCEmb a
tceFromList [(LocSymbol
c, (FTycon -> Sort
fTyconSort FTycon
tc, TCArgs
a)) | Embed (LocSymbol
c, FTycon
tc, TCArgs
a) <- [BPspec]
xs]
  , qualifiers :: [Qualifier]
Measure.qualifiers = [Qualifier
q | Qualif Qualifier
q <- [BPspec]
xs]
  , decr :: [(LocSymbol, [Line])]
Measure.decr       = [(LocSymbol, [Line])
d | Decr (LocSymbol, [Line])
d   <- [BPspec]
xs]
  , lvars :: HashSet LocSymbol
Measure.lvars      = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
d | LVars LocSymbol
d  <- [BPspec]
xs]
  , autois :: HashMap LocSymbol (Maybe Line)
Measure.autois     = [(LocSymbol, Maybe Line)] -> HashMap LocSymbol (Maybe Line)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(LocSymbol, Maybe Line)
s | Insts (LocSymbol, Maybe Line)
s <- [BPspec]
xs]
  , pragmas :: [Located String]
Measure.pragmas    = [Located String
s | Pragma Located String
s <- [BPspec]
xs]
  , cmeasures :: [Measure (Located BareType) ()]
Measure.cmeasures  = [Measure (Located BareType) ()
m | CMeas  Measure (Located BareType) ()
m <- [BPspec]
xs]
  , imeasures :: [Measure (Located BareType) LocSymbol]
Measure.imeasures  = [Measure (Located BareType) LocSymbol
m | IMeas  Measure (Located BareType) LocSymbol
m <- [BPspec]
xs]
  , classes :: [RClass (Located BareType)]
Measure.classes    = [RClass (Located BareType)
c | Class  RClass (Located BareType)
c <- [BPspec]
xs]
  , claws :: [RClass (Located BareType)]
Measure.claws      = [RClass (Located BareType)
c | CLaws  RClass (Located BareType)
c <- [BPspec]
xs]
  , dvariance :: [(LocSymbol, [Variance])]
Measure.dvariance  = [(LocSymbol, [Variance])
v | Varia  (LocSymbol, [Variance])
v <- [BPspec]
xs]
  , rinstance :: [RInstance (Located BareType)]
Measure.rinstance  = [RInstance (Located BareType)
i | RInst  RInstance (Located BareType)
i <- [BPspec]
xs]
  , ilaws :: [RILaws (Located BareType)]
Measure.ilaws      = [RILaws (Located BareType)
i | ILaws  RILaws (Located BareType)
i <- [BPspec]
xs]
  , termexprs :: [(LocSymbol, [Located Expr])]
Measure.termexprs  = [(LocSymbol
y, [Located Expr]
es) | Asrts ([LocSymbol]
ys, (Located BareType
_, Just [Located Expr]
es)) <- [BPspec]
xs, LocSymbol
y <- [LocSymbol]
ys]
  , lazy :: HashSet LocSymbol
Measure.lazy       = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
s | Lazy   LocSymbol
s <- [BPspec]
xs]
  , fails :: HashSet LocSymbol
Measure.fails      = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
s | Fail   LocSymbol
s <- [BPspec]
xs]
  , rewrites :: HashSet LocSymbol
Measure.rewrites   = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
s | Rewrite LocSymbol
s <- [BPspec]
xs]
  , rewriteWith :: HashMap LocSymbol [LocSymbol]
Measure.rewriteWith = [(LocSymbol, [LocSymbol])] -> HashMap LocSymbol [LocSymbol]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(LocSymbol, [LocSymbol])
s | Rewritewith (LocSymbol, [LocSymbol])
s <- [BPspec]
xs]
  , bounds :: RRBEnv (Located BareType)
Measure.bounds     = [(LocSymbol, Bound (Located BareType) Expr)]
-> RRBEnv (Located BareType)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(Bound (Located BareType) Expr -> LocSymbol
forall t e. Bound t e -> LocSymbol
bname Bound (Located BareType) Expr
i, Bound (Located BareType) Expr
i) | PBound Bound (Located BareType) Expr
i <- [BPspec]
xs]
  , reflects :: HashSet LocSymbol
Measure.reflects   = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
s | Reflect LocSymbol
s <- [BPspec]
xs]
  , hmeas :: HashSet LocSymbol
Measure.hmeas      = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
s | HMeas  LocSymbol
s <- [BPspec]
xs]
  , inlines :: HashSet LocSymbol
Measure.inlines    = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
s | Inline LocSymbol
s <- [BPspec]
xs]
  , ignores :: HashSet LocSymbol
Measure.ignores    = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
s | Ignore LocSymbol
s <- [BPspec]
xs]
  , autosize :: HashSet LocSymbol
Measure.autosize   = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
s | ASize  LocSymbol
s <- [BPspec]
xs]
  , hbounds :: HashSet LocSymbol
Measure.hbounds    = [LocSymbol] -> HashSet LocSymbol
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList [LocSymbol
s | HBound LocSymbol
s <- [BPspec]
xs]
  , defs :: HashMap LocSymbol Symbol
Measure.defs       = [(LocSymbol, Symbol)] -> HashMap LocSymbol Symbol
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(LocSymbol, Symbol)
d | Define (LocSymbol, Symbol)
d <- [BPspec]
xs]
  , axeqs :: [Equation]
Measure.axeqs      = []
  }

-- | Parse a single top level liquid specification
specP :: Parser BPspec
specP :: Parser BPspec
specP
  =     (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"assume"     (((LocSymbol, Located BareType) -> BPspec)
-> ParsecT
     String Integer (State PState) (LocSymbol, Located BareType)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, Located BareType) -> BPspec
forall ty ctor. (LocSymbol, ty) -> Pspec ty ctor
Assm    ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP  ))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"assert"     (((LocSymbol, Located BareType) -> BPspec)
-> ParsecT
     String Integer (State PState) (LocSymbol, Located BareType)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, Located BareType) -> BPspec
forall ty ctor. (LocSymbol, ty) -> Pspec ty ctor
Asrt    ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP  ))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"autosize"   ((LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
ASize   ParsecT String Integer (State PState) LocSymbol
asizeP   ))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"local"         Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((LocSymbol, Located BareType) -> BPspec)
-> ParsecT
     String Integer (State PState) (LocSymbol, Located BareType)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, Located BareType) -> BPspec
forall ty ctor. (LocSymbol, ty) -> Pspec ty ctor
LAsrt   ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP  )

    -- TODO: These next two are synonyms, kill one
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"axiomatize" ((LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
Reflect ParsecT String Integer (State PState) LocSymbol
axiomP   ))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"reflect"    ((LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
Reflect ParsecT String Integer (State PState) LocSymbol
axiomP   ))

    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"measure"    Parser BPspec
hmeasureP)

    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"define"     (((LocSymbol, Symbol) -> BPspec)
-> Parser (LocSymbol, Symbol) -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, Symbol) -> BPspec
forall ty ctor. (LocSymbol, Symbol) -> Pspec ty ctor
Define  Parser (LocSymbol, Symbol)
defineP  ))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"infixl"        Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (() -> BPspec) -> Parser () -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM () -> BPspec
forall ty ctor. () -> Pspec ty ctor
BFix    Parser ()
infixlP  )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"infixr"        Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (() -> BPspec) -> Parser () -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM () -> BPspec
forall ty ctor. () -> Pspec ty ctor
BFix    Parser ()
infixrP  )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"infix"         Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (() -> BPspec) -> Parser () -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM () -> BPspec
forall ty ctor. () -> Pspec ty ctor
BFix    Parser ()
infixP   )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"inline"     ((LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
Inline  ParsecT String Integer (State PState) LocSymbol
inlineP  ))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"ignore"     ((LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
Ignore  ParsecT String Integer (State PState) LocSymbol
inlineP  ))

    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"bound"    ((((Bound (Located BareType) Expr -> BPspec)
-> Parser (Bound (Located BareType) Expr) -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bound (Located BareType) Expr -> BPspec
forall ty ctor. Bound ty Expr -> Pspec ty ctor
PBound  Parser (Bound (Located BareType) Expr)
boundP   )
                                Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
HBound  ParsecT String Integer (State PState) LocSymbol
hboundP  ))))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"class"
         Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((String -> Parser ()
reserved String
"measure"  Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Measure (Located BareType) () -> BPspec)
-> ParsecT
     String Integer (State PState) (Measure (Located BareType) ())
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Measure (Located BareType) () -> BPspec
forall ty ctor. Measure ty () -> Pspec ty ctor
CMeas  ParsecT
  String Integer (State PState) (Measure (Located BareType) ())
cMeasureP )
         Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"laws"     Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RClass (Located BareType) -> BPspec)
-> ParsecT
     String Integer (State PState) (RClass (Located BareType))
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM RClass (Located BareType) -> BPspec
forall ty ctor. RClass ty -> Pspec ty ctor
CLaws  ParsecT String Integer (State PState) (RClass (Located BareType))
classP)
         Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (RClass (Located BareType) -> BPspec)
-> ParsecT
     String Integer (State PState) (RClass (Located BareType))
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM RClass (Located BareType) -> BPspec
forall ty ctor. RClass ty -> Pspec ty ctor
Class  ParsecT String Integer (State PState) (RClass (Located BareType))
classP                            ))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"instance"
         Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((String -> Parser ()
reserved String
"measure"  Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Measure (Located BareType) LocSymbol -> BPspec)
-> ParsecT
     String
     Integer
     (State PState)
     (Measure (Located BareType) LocSymbol)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Measure (Located BareType) LocSymbol -> BPspec
forall ty ctor. Measure ty ctor -> Pspec ty ctor
IMeas  ParsecT
  String
  Integer
  (State PState)
  (Measure (Located BareType) LocSymbol)
iMeasureP )
         Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"laws"     Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (RILaws (Located BareType) -> BPspec)
-> ParsecT
     String Integer (State PState) (RILaws (Located BareType))
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM RILaws (Located BareType) -> BPspec
forall ty ctor. RILaws ty -> Pspec ty ctor
ILaws ParsecT String Integer (State PState) (RILaws (Located BareType))
instanceLawP)
         Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (RInstance (Located BareType) -> BPspec)
-> ParsecT
     String Integer (State PState) (RInstance (Located BareType))
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM RInstance (Located BareType) -> BPspec
forall ty ctor. RInstance ty -> Pspec ty ctor
RInst  ParsecT
  String Integer (State PState) (RInstance (Located BareType))
instanceP ))

    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"import"        Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Symbol -> BPspec) -> Parser Symbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Symbol -> BPspec
forall ty ctor. Symbol -> Pspec ty ctor
Impt   Parser Symbol
symbolP   )

    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"data"
        Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((String -> Parser ()
reserved String
"variance"  Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((LocSymbol, [Variance]) -> BPspec)
-> ParsecT String Integer (State PState) (LocSymbol, [Variance])
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, [Variance]) -> BPspec
forall ty ctor. (LocSymbol, [Variance]) -> Pspec ty ctor
Varia  ParsecT String Integer (State PState) (LocSymbol, [Variance])
datavarianceP)
                                 Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (DataDecl -> BPspec)
-> ParsecT String Integer (State PState) DataDecl -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM DataDecl -> BPspec
forall ty ctor. DataDecl -> Pspec ty ctor
DDecl  ParsecT String Integer (State PState) DataDecl
dataDeclP ))

    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"newtype"       Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (DataDecl -> BPspec)
-> ParsecT String Integer (State PState) DataDecl -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM DataDecl -> BPspec
forall ty ctor. DataDecl -> Pspec ty ctor
NTDecl ParsecT String Integer (State PState) DataDecl
dataDeclP )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"include"       Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> BPspec) -> Parser String -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> BPspec
forall ty ctor. String -> Pspec ty ctor
Incl   Parser String
filePathP )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"invariant"  ((Located BareType -> BPspec)
-> ParsecT String Integer (State PState) (Located BareType)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Located BareType -> BPspec
forall ty ctor. ty -> Pspec ty ctor
Invt   ParsecT String Integer (State PState) (Located BareType)
invariantP))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"using"         Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Located BareType, Located BareType) -> BPspec)
-> ParsecT
     String Integer (State PState) (Located BareType, Located BareType)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Located BareType, Located BareType) -> BPspec
forall ty ctor. (ty, ty) -> Pspec ty ctor
Using ParsecT
  String Integer (State PState) (Located BareType, Located BareType)
invaliasP )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"type"          Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Located (RTAlias Symbol BareType) -> BPspec)
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol BareType))
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Located (RTAlias Symbol BareType) -> BPspec
forall ty ctor. Located (RTAlias Symbol BareType) -> Pspec ty ctor
Alias  ParsecT
  String Integer (State PState) (Located (RTAlias Symbol BareType))
aliasP    )

    -- TODO: Next two are basically synonyms
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"predicate"  ((Located (RTAlias Symbol Expr) -> BPspec)
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol Expr))
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Located (RTAlias Symbol Expr) -> BPspec
forall ty ctor. Located (RTAlias Symbol Expr) -> Pspec ty ctor
EAlias ParsecT
  String Integer (State PState) (Located (RTAlias Symbol Expr))
ealiasP   ))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"expression" ((Located (RTAlias Symbol Expr) -> BPspec)
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol Expr))
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Located (RTAlias Symbol Expr) -> BPspec
forall ty ctor. Located (RTAlias Symbol Expr) -> Pspec ty ctor
EAlias ParsecT
  String Integer (State PState) (Located (RTAlias Symbol Expr))
ealiasP   ))

    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"embed"      (((LocSymbol, FTycon, TCArgs) -> BPspec)
-> ParsecT
     String Integer (State PState) (LocSymbol, FTycon, TCArgs)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, FTycon, TCArgs) -> BPspec
forall ty ctor. (LocSymbol, FTycon, TCArgs) -> Pspec ty ctor
Embed  ParsecT String Integer (State PState) (LocSymbol, FTycon, TCArgs)
embedP    ))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
"qualif"     ((Qualifier -> BPspec)
-> ParsecT String Integer (State PState) Qualifier -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Qualifier -> BPspec
forall ty ctor. Qualifier -> Pspec ty ctor
Qualif (Parser Sort -> ParsecT String Integer (State PState) Qualifier
qualifierP Parser Sort
sortP)))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"decrease"      Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((LocSymbol, [Line]) -> BPspec)
-> ParsecT String Integer (State PState) (LocSymbol, [Line])
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, [Line]) -> BPspec
forall ty ctor. (LocSymbol, [Line]) -> Pspec ty ctor
Decr   ParsecT String Integer (State PState) (LocSymbol, [Line])
decreaseP )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"lazyvar"       Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
LVars  ParsecT String Integer (State PState) LocSymbol
lazyVarP  )

    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"lazy"          Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
Lazy   ParsecT String Integer (State PState) LocSymbol
lazyVarP  )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"rewrite"       Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
Rewrite   ParsecT String Integer (State PState) LocSymbol
rewriteVarP )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"rewriteWith"   Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((LocSymbol, [LocSymbol]) -> BPspec)
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, [LocSymbol]) -> BPspec
forall ty ctor. (LocSymbol, [LocSymbol]) -> Pspec ty ctor
Rewritewith   ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
rewriteWithP )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"fail"          Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (LocSymbol -> BPspec)
-> ParsecT String Integer (State PState) LocSymbol -> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
Fail   ParsecT String Integer (State PState) LocSymbol
failVarP  )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"ple"           Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((LocSymbol, Maybe Line) -> BPspec)
-> ParsecT String Integer (State PState) (LocSymbol, Maybe Line)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, Maybe Line) -> BPspec
forall ty ctor. (LocSymbol, Maybe Line) -> Pspec ty ctor
Insts ParsecT String Integer (State PState) (LocSymbol, Maybe Line)
autoinstP  )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"automatic-instances" Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((LocSymbol, Maybe Line) -> BPspec)
-> ParsecT String Integer (State PState) (LocSymbol, Maybe Line)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (LocSymbol, Maybe Line) -> BPspec
forall ty ctor. (LocSymbol, Maybe Line) -> Pspec ty ctor
Insts ParsecT String Integer (State PState) (LocSymbol, Maybe Line)
autoinstP  )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"LIQUID"        Parser () -> Parser BPspec -> Parser BPspec
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Located String -> BPspec)
-> ParsecT String Integer (State PState) (Located String)
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Located String -> BPspec
forall ty ctor. Located String -> Pspec ty ctor
Pragma ParsecT String Integer (State PState) (Located String)
pragmaP   )
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> {- DEFAULT -}                (([LocSymbol], (Located BareType, Maybe [Located Expr])) -> BPspec)
-> ParsecT
     String
     Integer
     (State PState)
     ([LocSymbol], (Located BareType, Maybe [Located Expr]))
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([LocSymbol], (Located BareType, Maybe [Located Expr])) -> BPspec
forall ty ctor.
([LocSymbol], (ty, Maybe [Located Expr])) -> Pspec ty ctor
Asrts  ParsecT
  String
  Integer
  (State PState)
  ([LocSymbol], (Located BareType, Maybe [Located Expr]))
tyBindsP
    Parser BPspec -> String -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"specP"

-- | Try the given parser on the tail after matching the reserved word, and if
-- it fails fall back to parsing it as a haskell signature for a function with
-- the same name.
fallbackSpecP :: String -> Parser BPspec -> Parser BPspec
fallbackSpecP :: String -> Parser BPspec -> Parser BPspec
fallbackSpecP String
kw Parser BPspec
p = do
  (Loc SourcePos
l1 SourcePos
l2 ()
_) <- Parser () -> Parser (Located ())
forall a. Parser a -> Parser (Located a)
locParserP (String -> Parser ()
reserved String
kw)
  (Parser BPspec
p Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (([LocSymbol], (Located BareType, Maybe [Located Expr])) -> BPspec)
-> ParsecT
     String
     Integer
     (State PState)
     ([LocSymbol], (Located BareType, Maybe [Located Expr]))
-> Parser BPspec
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([LocSymbol], (Located BareType, Maybe [Located Expr])) -> BPspec
forall ty ctor.
([LocSymbol], (ty, Maybe [Located Expr])) -> Pspec ty ctor
Asrts (LocSymbol
-> ParsecT
     String
     Integer
     (State PState)
     ([LocSymbol], (Located BareType, Maybe [Located Expr]))
tyBindsRemP (SourcePos -> SourcePos -> Symbol -> LocSymbol
forall a. SourcePos -> SourcePos -> a -> Located a
Loc SourcePos
l1 SourcePos
l2 (String -> Symbol
forall a. Symbolic a => a -> Symbol
symbol String
kw)) ))

-- | Same as tyBindsP, except the single initial symbol has already been matched
tyBindsRemP :: LocSymbol -> Parser ([LocSymbol], (Located BareType, Maybe [Located Expr]))
tyBindsRemP :: LocSymbol
-> ParsecT
     String
     Integer
     (State PState)
     ([LocSymbol], (Located BareType, Maybe [Located Expr]))
tyBindsRemP LocSymbol
sym = do
  Parser String
dcolon
  (Located BareType, Maybe [Located Expr])
tb <- Parser (Located BareType, Maybe [Located Expr])
termBareTypeP
  ([LocSymbol], (Located BareType, Maybe [Located Expr]))
-> ParsecT
     String
     Integer
     (State PState)
     ([LocSymbol], (Located BareType, Maybe [Located Expr]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LocSymbol
sym],(Located BareType, Maybe [Located Expr])
tb)

pragmaP :: Parser (Located String)
pragmaP :: ParsecT String Integer (State PState) (Located String)
pragmaP = Parser String
-> ParsecT String Integer (State PState) (Located String)
forall a. Parser a -> Parser (Located a)
locParserP Parser String
stringLiteral

autoinstP :: Parser (LocSymbol, Maybe Int)
autoinstP :: ParsecT String Integer (State PState) (LocSymbol, Maybe Line)
autoinstP = do LocSymbol
x <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP
               Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
               Maybe Integer
i <- Parser Integer
-> ParsecT String Integer (State PState) (Maybe Integer)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeP (String -> Parser ()
reserved String
"with" Parser () -> Parser Integer -> Parser Integer
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Integer
integer)
               (LocSymbol, Maybe Line)
-> ParsecT String Integer (State PState) (LocSymbol, Maybe Line)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocSymbol
x, Integer -> Line
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Line) -> Maybe Integer -> Maybe Line
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
i)

lazyVarP :: Parser LocSymbol
lazyVarP :: ParsecT String Integer (State PState) LocSymbol
lazyVarP = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP


rewriteVarP :: Parser LocSymbol
rewriteVarP :: ParsecT String Integer (State PState) LocSymbol
rewriteVarP = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP

rewriteWithP :: Parser (LocSymbol, [LocSymbol])
rewriteWithP :: ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
rewriteWithP = do LocSymbol
s  <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP 
                  Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                  [LocSymbol]
ss <- ParsecT String Integer (State PState) [LocSymbol]
-> ParsecT String Integer (State PState) [LocSymbol]
forall u a. ParserT u a -> ParserT u a
brackets (ParsecT String Integer (State PState) [LocSymbol]
 -> ParsecT String Integer (State PState) [LocSymbol])
-> ParsecT String Integer (State PState) [LocSymbol]
-> ParsecT String Integer (State PState) [LocSymbol]
forall a b. (a -> b) -> a -> b
$ ParsecT String Integer (State PState) LocSymbol
-> Parser String
-> ParsecT String Integer (State PState) [LocSymbol]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 (Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP) Parser String
comma
                  Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
                  (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall (m :: * -> *) a. Monad m => a -> m a
return (LocSymbol
s, [LocSymbol]
ss)

failVarP :: Parser LocSymbol
failVarP :: ParsecT String Integer (State PState) LocSymbol
failVarP = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP

axiomP :: Parser LocSymbol
axiomP :: ParsecT String Integer (State PState) LocSymbol
axiomP = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP

hboundP :: Parser LocSymbol
hboundP :: ParsecT String Integer (State PState) LocSymbol
hboundP = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP

inlineP :: Parser LocSymbol
inlineP :: ParsecT String Integer (State PState) LocSymbol
inlineP = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP

asizeP :: Parser LocSymbol
asizeP :: ParsecT String Integer (State PState) LocSymbol
asizeP = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP

decreaseP :: Parser (LocSymbol, [Int])
decreaseP :: ParsecT String Integer (State PState) (LocSymbol, [Line])
decreaseP = ([Integer] -> [Line])
-> (LocSymbol, [Integer]) -> (LocSymbol, [Line])
forall b c a. (b -> c) -> (a, b) -> (a, c)
Misc.mapSnd [Integer] -> [Line]
forall (f :: * -> *) b. (Functor f, Num b) => f Integer -> f b
f ((LocSymbol, [Integer]) -> (LocSymbol, [Line]))
-> ParsecT String Integer (State PState) (LocSymbol, [Integer])
-> ParsecT String Integer (State PState) (LocSymbol, [Line])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LocSymbol -> [Integer] -> (LocSymbol, [Integer]))
-> ParsecT String Integer (State PState) LocSymbol
-> ParsecT String Integer (State PState) [Integer]
-> ParsecT String Integer (State PState) (LocSymbol, [Integer])
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP) (Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces Parser ()
-> ParsecT String Integer (State PState) [Integer]
-> ParsecT String Integer (State PState) [Integer]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Integer -> ParsecT String Integer (State PState) [Integer]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser Integer
integer)
  where
    f :: f Integer -> f b
f     = ((\Integer
n -> Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
n b -> b -> b
forall a. Num a => a -> a -> a
- b
1) (Integer -> b) -> f Integer -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

filePathP     :: Parser FilePath
filePathP :: Parser String
filePathP     = Parser String -> Parser String
forall a.
ParsecT String Integer (State PState) a
-> ParsecT String Integer (State PState) a
angles (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ ParsecT String Integer (State PState) Char -> Parser String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
pathCharP
  where
    pathCharP :: ParsecT s u m Char
pathCharP = [ParsecT s u m Char] -> ParsecT s u m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT s u m Char] -> ParsecT s u m Char)
-> [ParsecT s u m Char] -> ParsecT s u m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char (Char -> ParsecT s u m Char) -> String -> [ParsecT s u m Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
pathChars
    pathChars :: String
pathChars = [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'.', Char
'/']

datavarianceP :: Parser (Located Symbol, [Variance])
datavarianceP :: ParsecT String Integer (State PState) (LocSymbol, [Variance])
datavarianceP = (LocSymbol -> [Variance] -> (LocSymbol, [Variance]))
-> ParsecT String Integer (State PState) LocSymbol
-> ParsecT String Integer (State PState) [Variance]
-> ParsecT String Integer (State PState) (LocSymbol, [Variance])
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) ParsecT String Integer (State PState) LocSymbol
locUpperIdP (Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces Parser ()
-> ParsecT String Integer (State PState) [Variance]
-> ParsecT String Integer (State PState) [Variance]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) [Variance]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String Integer (State PState) Variance
varianceP)

varianceP :: Parser Variance
varianceP :: ParsecT String Integer (State PState) Variance
varianceP = (String -> Parser ()
reserved String
"bivariant"     Parser ()
-> ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Variance -> ParsecT String Integer (State PState) Variance
forall (m :: * -> *) a. Monad m => a -> m a
return Variance
Bivariant)
        ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"invariant"     Parser ()
-> ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Variance -> ParsecT String Integer (State PState) Variance
forall (m :: * -> *) a. Monad m => a -> m a
return Variance
Invariant)
        ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"covariant"     Parser ()
-> ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Variance -> ParsecT String Integer (State PState) Variance
forall (m :: * -> *) a. Monad m => a -> m a
return Variance
Covariant)
        ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"contravariant" Parser ()
-> ParsecT String Integer (State PState) Variance
-> ParsecT String Integer (State PState) Variance
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Variance -> ParsecT String Integer (State PState) Variance
forall (m :: * -> *) a. Monad m => a -> m a
return Variance
Contravariant)
        ParsecT String Integer (State PState) Variance
-> String -> ParsecT String Integer (State PState) Variance
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Invalid variance annotation\t Use one of bivariant, invariant, covariant, contravariant"

tyBindsP :: Parser ([LocSymbol], (Located BareType, Maybe [Located Expr]))
tyBindsP :: ParsecT
  String
  Integer
  (State PState)
  ([LocSymbol], (Located BareType, Maybe [Located Expr]))
tyBindsP = do 
  ([LocSymbol]
xs, (Located BareType, Maybe [Located Expr])
z) <- ParsecT String Integer (State PState) [LocSymbol]
-> Parser String
-> Parser (Located BareType, Maybe [Located Expr])
-> ParsecT
     String
     Integer
     (State PState)
     ([LocSymbol], (Located BareType, Maybe [Located Expr]))
forall x a y. Parser x -> Parser a -> Parser y -> Parser (x, y)
xyP (ParsecT String Integer (State PState) LocSymbol
-> Parser String
-> ParsecT String Integer (State PState) [LocSymbol]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP) Parser String
comma) Parser String
dcolon Parser (Located BareType, Maybe [Located Expr])
termBareTypeP
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([LocSymbol] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LocSymbol]
xs) (String -> Parser ()
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Type signature " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Located BareType, Maybe [Located Expr]) -> String
forall a. Show a => a -> String
show (Located BareType, Maybe [Located Expr])
z String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" must have non-empty list of binders!") 
  ([LocSymbol], (Located BareType, Maybe [Located Expr]))
-> ParsecT
     String
     Integer
     (State PState)
     ([LocSymbol], (Located BareType, Maybe [Located Expr]))
forall (m :: * -> *) a. Monad m => a -> m a
return ([LocSymbol]
xs, (Located BareType, Maybe [Located Expr])
z)


tyBindNoLocP :: Parser (LocSymbol, BareType)
tyBindNoLocP :: ParsecT String Integer (State PState) (LocSymbol, BareType)
tyBindNoLocP = (Located BareType -> BareType)
-> (LocSymbol, Located BareType) -> (LocSymbol, BareType)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Located BareType -> BareType
forall a. Located a -> a
val ((LocSymbol, Located BareType) -> (LocSymbol, BareType))
-> ParsecT
     String Integer (State PState) (LocSymbol, Located BareType)
-> ParsecT String Integer (State PState) (LocSymbol, BareType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP


tyBindP    :: Parser (LocSymbol, Located BareType)
tyBindP :: ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP    = ParsecT String Integer (State PState) LocSymbol
-> Parser String
-> ParsecT String Integer (State PState) (Located BareType)
-> ParsecT
     String Integer (State PState) (LocSymbol, Located BareType)
forall x a y. Parser x -> Parser a -> Parser y -> Parser (x, y)
xyP ParsecT String Integer (State PState) LocSymbol
xP Parser String
dcolon ParsecT String Integer (State PState) (Located BareType)
tP
  where
    xP :: ParsecT String Integer (State PState) LocSymbol
xP     = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP
    tP :: ParsecT String Integer (State PState) (Located BareType)
tP     = ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP ParsecT String Integer (State PState) BareType
genBareTypeP

termBareTypeP :: Parser (Located BareType, Maybe [Located Expr])
termBareTypeP :: Parser (Located BareType, Maybe [Located Expr])
termBareTypeP = do
  Located BareType
t <- ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP ParsecT String Integer (State PState) BareType
genBareTypeP
  (Located BareType -> Parser (Located BareType, Maybe [Located Expr])
termTypeP Located BareType
t
    Parser (Located BareType, Maybe [Located Expr])
-> Parser (Located BareType, Maybe [Located Expr])
-> Parser (Located BareType, Maybe [Located Expr])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Located BareType, Maybe [Located Expr])
-> Parser (Located BareType, Maybe [Located Expr])
forall (m :: * -> *) a. Monad m => a -> m a
return (Located BareType
t, Maybe [Located Expr]
forall a. Maybe a
Nothing))

termTypeP :: Located BareType ->Parser (Located BareType, Maybe [Located Expr])
termTypeP :: Located BareType -> Parser (Located BareType, Maybe [Located Expr])
termTypeP Located BareType
t
  = do
       String -> Parser ()
reservedOp String
"/"
       [Located Expr]
es <- ParserT Integer [Located Expr] -> ParserT Integer [Located Expr]
forall u a. ParserT u a -> ParserT u a
brackets (ParserT Integer [Located Expr] -> ParserT Integer [Located Expr])
-> ParserT Integer [Located Expr] -> ParserT Integer [Located Expr]
forall a b. (a -> b) -> a -> b
$ ParsecT String Integer (State PState) (Located Expr)
-> Parser String -> ParserT Integer [Located Expr]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy (Parser Expr -> ParsecT String Integer (State PState) (Located Expr)
forall a. Parser a -> Parser (Located a)
locParserP Parser Expr
exprP) Parser String
comma
       (Located BareType, Maybe [Located Expr])
-> Parser (Located BareType, Maybe [Located Expr])
forall (m :: * -> *) a. Monad m => a -> m a
return (Located BareType
t, [Located Expr] -> Maybe [Located Expr]
forall a. a -> Maybe a
Just [Located Expr]
es)

-- -------------------------------------

invariantP :: Parser (Located BareType)
invariantP :: ParsecT String Integer (State PState) (Located BareType)
invariantP = ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP ParsecT String Integer (State PState) BareType
genBareTypeP

invaliasP :: Parser (Located BareType, Located BareType)
invaliasP :: ParsecT
  String Integer (State PState) (Located BareType, Located BareType)
invaliasP
  = do Located BareType
t  <- ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP ParsecT String Integer (State PState) BareType
genBareTypeP
       String -> Parser ()
reserved String
"as"
       Located BareType
ta <- ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP ParsecT String Integer (State PState) BareType
genBareTypeP
       (Located BareType, Located BareType)
-> ParsecT
     String Integer (State PState) (Located BareType, Located BareType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located BareType
t, Located BareType
ta)

genBareTypeP :: Parser BareType
genBareTypeP :: ParsecT String Integer (State PState) BareType
genBareTypeP = ParsecT String Integer (State PState) BareType
bareTypeP

embedP :: Parser (Located Symbol, FTycon, TCArgs)
embedP :: ParsecT String Integer (State PState) (LocSymbol, FTycon, TCArgs)
embedP = do 
  LocSymbol
x <- ParsecT String Integer (State PState) LocSymbol
locUpperIdP 
  TCArgs
a <- ParsecT String Integer (State PState) TCArgs
-> ParsecT String Integer (State PState) TCArgs
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Parser ()
reserved String
"*" Parser ()
-> ParsecT String Integer (State PState) TCArgs
-> ParsecT String Integer (State PState) TCArgs
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TCArgs -> ParsecT String Integer (State PState) TCArgs
forall (m :: * -> *) a. Monad m => a -> m a
return TCArgs
WithArgs) ParsecT String Integer (State PState) TCArgs
-> ParsecT String Integer (State PState) TCArgs
-> ParsecT String Integer (State PState) TCArgs
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> TCArgs -> ParsecT String Integer (State PState) TCArgs
forall (m :: * -> *) a. Monad m => a -> m a
return TCArgs
NoArgs 
  ()
_ <- Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser ()
reserved String
"as"
  FTycon
t <- Parser FTycon
fTyConP   
  (LocSymbol, FTycon, TCArgs)
-> ParsecT
     String Integer (State PState) (LocSymbol, FTycon, TCArgs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocSymbol
x, FTycon
t, TCArgs
a)
  --  = xyP locUpperIdP symbolTCArgs (reserved "as") fTyConP


aliasP :: Parser (Located (RTAlias Symbol BareType))
aliasP :: ParsecT
  String Integer (State PState) (Located (RTAlias Symbol BareType))
aliasP  = (Symbol -> Symbol)
-> ParsecT String Integer (State PState) BareType
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol BareType))
forall tv ty.
(Symbol -> tv) -> Parser ty -> Parser (Located (RTAlias tv ty))
rtAliasP Symbol -> Symbol
forall a. a -> a
id     ParsecT String Integer (State PState) BareType
bareTypeP

ealiasP :: Parser (Located (RTAlias Symbol Expr))
ealiasP :: ParsecT
  String Integer (State PState) (Located (RTAlias Symbol Expr))
ealiasP = ParsecT
  String Integer (State PState) (Located (RTAlias Symbol Expr))
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol Expr))
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((Symbol -> Symbol)
-> Parser Expr
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol Expr))
forall tv ty.
(Symbol -> tv) -> Parser ty -> Parser (Located (RTAlias tv ty))
rtAliasP Symbol -> Symbol
forall a. Symbolic a => a -> Symbol
symbol Parser Expr
predP)
      ParsecT
  String Integer (State PState) (Located (RTAlias Symbol Expr))
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol Expr))
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol Expr))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Symbol -> Symbol)
-> Parser Expr
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol Expr))
forall tv ty.
(Symbol -> tv) -> Parser ty -> Parser (Located (RTAlias tv ty))
rtAliasP Symbol -> Symbol
forall a. Symbolic a => a -> Symbol
symbol Parser Expr
exprP
      ParsecT
  String Integer (State PState) (Located (RTAlias Symbol Expr))
-> String
-> ParsecT
     String Integer (State PState) (Located (RTAlias Symbol Expr))
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"ealiasP"

rtAliasP :: (Symbol -> tv) -> Parser ty -> Parser (Located (RTAlias tv ty))
rtAliasP :: (Symbol -> tv) -> Parser ty -> Parser (Located (RTAlias tv ty))
rtAliasP Symbol -> tv
f Parser ty
bodyP
  -- TODO:AZ pretty sure that all the 'spaces' can be removed below, given
  --         proper use of reserved and reservedOp now
  = do SourcePos
pos  <- ParsecT String Integer (State PState) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
       Symbol
name <- Parser Symbol
upperIdP
       Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
       [Symbol]
args <- Parser Symbol
-> Parser String -> ParsecT String Integer (State PState) [Symbol]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy Parser Symbol
aliasIdP Parser String
blanks
       Parser ()
whiteSpace Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser ()
reservedOp String
"=" Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
whiteSpace
       ty
body <- Parser ty
bodyP
       SourcePos
posE <- ParsecT String Integer (State PState) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
       let ([Symbol]
tArgs, [Symbol]
vArgs) = (Symbol -> Bool) -> [Symbol] -> ([Symbol], [Symbol])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Char -> Bool
isSmall (Char -> Bool) -> (Symbol -> Char) -> Symbol -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Char
headSym) [Symbol]
args
       Located (RTAlias tv ty) -> Parser (Located (RTAlias tv ty))
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (RTAlias tv ty) -> Parser (Located (RTAlias tv ty)))
-> Located (RTAlias tv ty) -> Parser (Located (RTAlias tv ty))
forall a b. (a -> b) -> a -> b
$ SourcePos -> SourcePos -> RTAlias tv ty -> Located (RTAlias tv ty)
forall a. SourcePos -> SourcePos -> a -> Located a
Loc SourcePos
pos SourcePos
posE (Symbol -> [tv] -> [Symbol] -> ty -> RTAlias tv ty
forall x a. Symbol -> [x] -> [Symbol] -> a -> RTAlias x a
RTA Symbol
name (Symbol -> tv
f (Symbol -> tv) -> [Symbol] -> [tv]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
tArgs) [Symbol]
vArgs ty
body)

aliasIdP :: Parser Symbol
aliasIdP :: Parser Symbol
aliasIdP = ParsecT String Integer (State PState) Char
-> HashSet Char -> (String -> Bool) -> Parser Symbol
condIdP (ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String Integer (State PState) Char
-> ParsecT String Integer (State PState) Char
-> ParsecT String Integer (State PState) Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_') HashSet Char
alphaNums (Char -> Bool
isAlpha (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. [a] -> a
head)
           where
             alphaNums :: HashSet Char
alphaNums = String -> HashSet Char
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList (String -> HashSet Char) -> String -> HashSet Char
forall a b. (a -> b) -> a -> b
$ [Char
'A' .. Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9']

hmeasureP :: Parser BPspec
hmeasureP :: Parser BPspec
hmeasureP = do
  LocSymbol
b <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP
  Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ((do Parser String
dcolon
       Located BareType
ty <- ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP ParsecT String Integer (State PState) BareType
genBareTypeP
       Parser ()
whiteSpace
       [Def (Located BareType) LocSymbol]
eqns <- ParsecT
  String Integer (State PState) (Def (Located BareType) LocSymbol)
-> ParsecT
     String Integer (State PState) [Def (Located BareType) LocSymbol]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
grabs (ParsecT
   String Integer (State PState) (Def (Located BareType) LocSymbol)
 -> ParsecT
      String Integer (State PState) [Def (Located BareType) LocSymbol])
-> ParsecT
     String Integer (State PState) (Def (Located BareType) LocSymbol)
-> ParsecT
     String Integer (State PState) [Def (Located BareType) LocSymbol]
forall a b. (a -> b) -> a -> b
$ Parser Body
-> ParsecT
     String Integer (State PState) (Def (Located BareType) LocSymbol)
measureDefP (Parser Body
rawBodyP Parser Body -> Parser Body -> Parser Body
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Located BareType -> Parser Body
tyBodyP Located BareType
ty)
       BPspec -> Parser BPspec
forall (m :: * -> *) a. Monad m => a -> m a
return (Measure (Located BareType) LocSymbol -> BPspec
forall ty ctor. Measure ty ctor -> Pspec ty ctor
Meas (Measure (Located BareType) LocSymbol -> BPspec)
-> Measure (Located BareType) LocSymbol -> BPspec
forall a b. (a -> b) -> a -> b
$ LocSymbol
-> Located BareType
-> [Def (Located BareType) LocSymbol]
-> MeasureKind
-> UnSortedExprs
-> Measure (Located BareType) LocSymbol
forall ty bndr.
LocSymbol
-> ty
-> [Def ty bndr]
-> MeasureKind
-> UnSortedExprs
-> Measure ty bndr
Measure.mkM LocSymbol
b Located BareType
ty [Def (Located BareType) LocSymbol]
eqns MeasureKind
MsMeasure UnSortedExprs
forall a. Monoid a => a
mempty))
    Parser BPspec -> Parser BPspec -> Parser BPspec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (BPspec -> Parser BPspec
forall (m :: * -> *) a. Monad m => a -> m a
return (LocSymbol -> BPspec
forall ty ctor. LocSymbol -> Pspec ty ctor
HMeas LocSymbol
b))
    )

measureP :: Parser (Measure (Located BareType) LocSymbol)
measureP :: ParsecT
  String
  Integer
  (State PState)
  (Measure (Located BareType) LocSymbol)
measureP = do 
  (LocSymbol
x, Located BareType
ty) <- ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP
  Parser ()
whiteSpace
  [Def (Located BareType) LocSymbol]
eqns    <- ParsecT
  String Integer (State PState) (Def (Located BareType) LocSymbol)
-> ParsecT
     String Integer (State PState) [Def (Located BareType) LocSymbol]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
grabs (ParsecT
   String Integer (State PState) (Def (Located BareType) LocSymbol)
 -> ParsecT
      String Integer (State PState) [Def (Located BareType) LocSymbol])
-> ParsecT
     String Integer (State PState) (Def (Located BareType) LocSymbol)
-> ParsecT
     String Integer (State PState) [Def (Located BareType) LocSymbol]
forall a b. (a -> b) -> a -> b
$ Parser Body
-> ParsecT
     String Integer (State PState) (Def (Located BareType) LocSymbol)
measureDefP (Parser Body
rawBodyP Parser Body -> Parser Body -> Parser Body
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Located BareType -> Parser Body
tyBodyP Located BareType
ty)
  Measure (Located BareType) LocSymbol
-> ParsecT
     String
     Integer
     (State PState)
     (Measure (Located BareType) LocSymbol)
forall (m :: * -> *) a. Monad m => a -> m a
return   (Measure (Located BareType) LocSymbol
 -> ParsecT
      String
      Integer
      (State PState)
      (Measure (Located BareType) LocSymbol))
-> Measure (Located BareType) LocSymbol
-> ParsecT
     String
     Integer
     (State PState)
     (Measure (Located BareType) LocSymbol)
forall a b. (a -> b) -> a -> b
$ LocSymbol
-> Located BareType
-> [Def (Located BareType) LocSymbol]
-> MeasureKind
-> UnSortedExprs
-> Measure (Located BareType) LocSymbol
forall ty bndr.
LocSymbol
-> ty
-> [Def ty bndr]
-> MeasureKind
-> UnSortedExprs
-> Measure ty bndr
Measure.mkM LocSymbol
x Located BareType
ty [Def (Located BareType) LocSymbol]
eqns MeasureKind
MsMeasure UnSortedExprs
forall a. Monoid a => a
mempty

-- | class measure
cMeasureP :: Parser (Measure (Located BareType) ())
cMeasureP :: ParsecT
  String Integer (State PState) (Measure (Located BareType) ())
cMeasureP
  = do (LocSymbol
x, Located BareType
ty) <- ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP
       Measure (Located BareType) ()
-> ParsecT
     String Integer (State PState) (Measure (Located BareType) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Measure (Located BareType) ()
 -> ParsecT
      String Integer (State PState) (Measure (Located BareType) ()))
-> Measure (Located BareType) ()
-> ParsecT
     String Integer (State PState) (Measure (Located BareType) ())
forall a b. (a -> b) -> a -> b
$ LocSymbol
-> Located BareType
-> [Def (Located BareType) ()]
-> MeasureKind
-> UnSortedExprs
-> Measure (Located BareType) ()
forall ty bndr.
LocSymbol
-> ty
-> [Def ty bndr]
-> MeasureKind
-> UnSortedExprs
-> Measure ty bndr
Measure.mkM LocSymbol
x Located BareType
ty [] MeasureKind
MsClass UnSortedExprs
forall a. Monoid a => a
mempty 

iMeasureP :: Parser (Measure (Located BareType) LocSymbol)
iMeasureP :: ParsecT
  String
  Integer
  (State PState)
  (Measure (Located BareType) LocSymbol)
iMeasureP = ParsecT
  String
  Integer
  (State PState)
  (Measure (Located BareType) LocSymbol)
measureP


oneClassArg :: Parser [Located BareType]
oneClassArg :: ParsecT String Integer (State PState) [Located BareType]
oneClassArg
  = Located BareType -> [Located BareType]
forall a. a -> [a]
sing (Located BareType -> [Located BareType])
-> ParsecT String Integer (State PState) (Located BareType)
-> ParsecT String Integer (State PState) [Located BareType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP (BTyCon -> [BTyVar] -> BareType
forall r c tv. Monoid r => c -> [tv] -> RType c tv r
rit (BTyCon -> [BTyVar] -> BareType)
-> ParsecT String Integer (State PState) BTyCon
-> ParsecT String Integer (State PState) ([BTyVar] -> BareType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) BTyCon
classBTyConP ParsecT String Integer (State PState) ([BTyVar] -> BareType)
-> Parser [BTyVar]
-> ParsecT String Integer (State PState) BareType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Located BTyVar -> BTyVar) -> [Located BTyVar] -> [BTyVar]
forall a b. (a -> b) -> [a] -> [b]
map Located BTyVar -> BTyVar
forall a. Located a -> a
val ([Located BTyVar] -> [BTyVar])
-> ParsecT String Integer (State PState) [Located BTyVar]
-> Parser [BTyVar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) [Located BTyVar]
classParams))
  where
    rit :: c -> [tv] -> RType c tv r
rit c
t [tv]
as    = c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
forall c tv r.
c -> [RType c tv r] -> [RTProp c tv r] -> r -> RType c tv r
RApp c
t ((tv -> r -> RType c tv r
forall c tv r. tv -> r -> RType c tv r
`RVar` r
forall a. Monoid a => a
mempty) (tv -> RType c tv r) -> [tv] -> [RType c tv r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [tv]
as) [] r
forall a. Monoid a => a
mempty
    classParams :: ParsecT String Integer (State PState) [Located BTyVar]
classParams =  (String -> Parser ()
reserved String
"where" Parser ()
-> ParsecT String Integer (State PState) [Located BTyVar]
-> ParsecT String Integer (State PState) [Located BTyVar]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Located BTyVar]
-> ParsecT String Integer (State PState) [Located BTyVar]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
               ParsecT String Integer (State PState) [Located BTyVar]
-> ParsecT String Integer (State PState) [Located BTyVar]
-> ParsecT String Integer (State PState) [Located BTyVar]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((:) (Located BTyVar -> [Located BTyVar] -> [Located BTyVar])
-> ParsecT String Integer (State PState) (Located BTyVar)
-> ParsecT
     String
     Integer
     (State PState)
     ([Located BTyVar] -> [Located BTyVar])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Symbol -> BTyVar) -> LocSymbol -> Located BTyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Symbol -> BTyVar
bTyVar (LocSymbol -> Located BTyVar)
-> ParsecT String Integer (State PState) LocSymbol
-> ParsecT String Integer (State PState) (Located BTyVar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) LocSymbol
locLowerIdP) ParsecT
  String
  Integer
  (State PState)
  ([Located BTyVar] -> [Located BTyVar])
-> ParsecT String Integer (State PState) [Located BTyVar]
-> ParsecT String Integer (State PState) [Located BTyVar]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String Integer (State PState) [Located BTyVar]
classParams)
    sing :: a -> [a]
sing a
x      = [a
x]

instanceLawP :: Parser (RILaws (Located BareType))
instanceLawP :: ParsecT String Integer (State PState) (RILaws (Located BareType))
instanceLawP
  = do SourcePos
l1   <- ParsecT String Integer (State PState) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
       [Located BareType]
sups <- ParsecT String Integer (State PState) [Located BareType]
supersP
       BTyCon
c    <- ParsecT String Integer (State PState) BTyCon
classBTyConP
       Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
       [Located BareType]
tvs  <- ParsecT String Integer (State PState) (Located BareType)
-> Parser ()
-> ParsecT String Integer (State PState) [Located BareType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill (ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP ParsecT String Integer (State PState) BareType
bareTypeP) (Parser () -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
reserved String
"where")
       Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
       [(LocSymbol, LocSymbol)]
ms   <- ParsecT String Integer (State PState) (LocSymbol, LocSymbol)
-> ParsecT String Integer (State PState) [(LocSymbol, LocSymbol)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
grabs ParsecT String Integer (State PState) (LocSymbol, LocSymbol)
eqBinderP
       Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
       SourcePos
l2   <- ParsecT String Integer (State PState) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
       RILaws (Located BareType)
-> ParsecT
     String Integer (State PState) (RILaws (Located BareType))
forall (m :: * -> *) a. Monad m => a -> m a
return (RILaws (Located BareType)
 -> ParsecT
      String Integer (State PState) (RILaws (Located BareType)))
-> RILaws (Located BareType)
-> ParsecT
     String Integer (State PState) (RILaws (Located BareType))
forall a b. (a -> b) -> a -> b
$ BTyCon
-> [Located BareType]
-> [Located BareType]
-> [(LocSymbol, LocSymbol)]
-> Located ()
-> RILaws (Located BareType)
forall ty.
BTyCon
-> [ty]
-> [ty]
-> [(LocSymbol, LocSymbol)]
-> Located ()
-> RILaws ty
RIL BTyCon
c [Located BareType]
sups [Located BareType]
tvs [(LocSymbol, LocSymbol)]
ms (SourcePos -> SourcePos -> () -> Located ()
forall a. SourcePos -> SourcePos -> a -> Located a
Loc SourcePos
l1 SourcePos
l2 ())
  where
    superP :: ParsecT String Integer (State PState) (Located BareType)
superP   = ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP (BareType -> BareType
forall a. a -> a
toRCls (BareType -> BareType)
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) BareType
bareAtomBindP)
    supersP :: ParsecT String Integer (State PState) [Located BareType]
supersP  = ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (((ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall u a. ParserT u a -> ParserT u a
parens (ParsecT String Integer (State PState) (Located BareType)
superP ParsecT String Integer (State PState) (Located BareType)
-> Parser String
-> ParsecT String Integer (State PState) [Located BareType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` Parser String
comma)) ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Located BareType -> [Located BareType])
-> ParsecT String Integer (State PState) (Located BareType)
-> ParsecT String Integer (State PState) [Located BareType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located BareType -> [Located BareType]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParsecT String Integer (State PState) (Located BareType)
superP)
                       ParsecT String Integer (State PState) [Located BareType]
-> Parser ()
-> ParsecT String Integer (State PState) [Located BareType]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
reservedOp String
"=>")
               ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    toRCls :: p -> p
toRCls p
x = p
x

    eqBinderP :: ParsecT String Integer (State PState) (LocSymbol, LocSymbol)
eqBinderP = ParsecT String Integer (State PState) LocSymbol
-> Parser String
-> ParsecT String Integer (State PState) LocSymbol
-> ParsecT String Integer (State PState) (LocSymbol, LocSymbol)
forall x a y. Parser x -> Parser a -> Parser y -> Parser (x, y)
xyP ParsecT String Integer (State PState) LocSymbol
xP (Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces Parser () -> Parser String -> Parser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"=" Parser String -> Parser () -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces) (ParsecT String Integer (State PState) LocSymbol
xP ParsecT String Integer (State PState) LocSymbol
-> Parser () -> ParsecT String Integer (State PState) LocSymbol
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)
      
    xP :: ParsecT String Integer (State PState) LocSymbol
xP = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
binderP
    

instanceP :: Parser (RInstance (Located BareType))
instanceP :: ParsecT
  String Integer (State PState) (RInstance (Located BareType))
instanceP
  = do [Located BareType]
_    <- ParsecT String Integer (State PState) [Located BareType]
supersP
       BTyCon
c    <- ParsecT String Integer (State PState) BTyCon
classBTyConP
       Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
       [Located BareType]
tvs  <- (ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String Integer (State PState) [Located BareType]
oneClassArg) ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT String Integer (State PState) (Located BareType)
-> Parser ()
-> ParsecT String Integer (State PState) [Located BareType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill ParsecT String Integer (State PState) (Located BareType)
iargsP (Parser () -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
reserved String
"where"))
       [(LocSymbol, RISig (Located BareType))]
ms   <- ParsecT
  String Integer (State PState) (LocSymbol, RISig (Located BareType))
-> Parser String
-> ParsecT
     String
     Integer
     (State PState)
     [(LocSymbol, RISig (Located BareType))]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT
  String Integer (State PState) (LocSymbol, RISig (Located BareType))
riMethodSigP Parser String
semi
       Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
       RInstance (Located BareType)
-> ParsecT
     String Integer (State PState) (RInstance (Located BareType))
forall (m :: * -> *) a. Monad m => a -> m a
return (RInstance (Located BareType)
 -> ParsecT
      String Integer (State PState) (RInstance (Located BareType)))
-> RInstance (Located BareType)
-> ParsecT
     String Integer (State PState) (RInstance (Located BareType))
forall a b. (a -> b) -> a -> b
$ BTyCon
-> [Located BareType]
-> [(LocSymbol, RISig (Located BareType))]
-> RInstance (Located BareType)
forall t. BTyCon -> [t] -> [(LocSymbol, RISig t)] -> RInstance t
RI BTyCon
c [Located BareType]
tvs [(LocSymbol, RISig (Located BareType))]
ms
  where
    superP :: ParsecT String Integer (State PState) (Located BareType)
superP   = ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP (BareType -> BareType
forall a. a -> a
toRCls (BareType -> BareType)
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) BareType
bareAtomBindP)
    supersP :: ParsecT String Integer (State PState) [Located BareType]
supersP  = ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (((ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall u a. ParserT u a -> ParserT u a
parens (ParsecT String Integer (State PState) (Located BareType)
superP ParsecT String Integer (State PState) (Located BareType)
-> Parser String
-> ParsecT String Integer (State PState) [Located BareType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` Parser String
comma)) ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Located BareType -> [Located BareType])
-> ParsecT String Integer (State PState) (Located BareType)
-> ParsecT String Integer (State PState) [Located BareType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located BareType -> [Located BareType]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParsecT String Integer (State PState) (Located BareType)
superP)
                       ParsecT String Integer (State PState) [Located BareType]
-> Parser ()
-> ParsecT String Integer (State PState) [Located BareType]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
reservedOp String
"=>")
               ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    toRCls :: p -> p
toRCls p
x = p
x

    iargsP :: ParsecT String Integer (State PState) (Located BareType)
iargsP   =   (BTyVar -> Located BareType
forall r tv c. Monoid r => tv -> Located (RType c tv r)
mkVar (BTyVar -> Located BareType)
-> (Symbol -> BTyVar) -> Symbol -> Located BareType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> BTyVar
bTyVar (Symbol -> Located BareType)
-> Parser Symbol
-> ParsecT String Integer (State PState) (Located BareType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
tyVarIdP)
            ParsecT String Integer (State PState) (Located BareType)
-> ParsecT String Integer (State PState) (Located BareType)
-> ParsecT String Integer (State PState) (Located BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT String Integer (State PState) (Located BareType)
-> ParsecT String Integer (State PState) (Located BareType)
forall u a. ParserT u a -> ParserT u a
parens (ParsecT String Integer (State PState) (Located BareType)
 -> ParsecT String Integer (State PState) (Located BareType))
-> ParsecT String Integer (State PState) (Located BareType)
-> ParsecT String Integer (State PState) (Located BareType)
forall a b. (a -> b) -> a -> b
$ ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP (ParsecT String Integer (State PState) BareType
 -> ParsecT String Integer (State PState) (Located BareType))
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a b. (a -> b) -> a -> b
$ ParsecT String Integer (State PState) BareType
bareTypeP)


    mkVar :: tv -> Located (RType c tv r)
mkVar tv
v  = RType c tv r -> Located (RType c tv r)
forall a. a -> Located a
dummyLoc (RType c tv r -> Located (RType c tv r))
-> RType c tv r -> Located (RType c tv r)
forall a b. (a -> b) -> a -> b
$ tv -> r -> RType c tv r
forall c tv r. tv -> r -> RType c tv r
RVar tv
v r
forall a. Monoid a => a
mempty


riMethodSigP :: Parser (LocSymbol, RISig (Located BareType))
riMethodSigP :: ParsecT
  String Integer (State PState) (LocSymbol, RISig (Located BareType))
riMethodSigP
  = ParsecT
  String Integer (State PState) (LocSymbol, RISig (Located BareType))
-> ParsecT
     String Integer (State PState) (LocSymbol, RISig (Located BareType))
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do String -> Parser ()
reserved String
"assume"
            (LocSymbol
x, Located BareType
t) <- ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP
            (LocSymbol, RISig (Located BareType))
-> ParsecT
     String Integer (State PState) (LocSymbol, RISig (Located BareType))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocSymbol
x, Located BareType -> RISig (Located BareType)
forall t. t -> RISig t
RIAssumed Located BareType
t) )
 ParsecT
  String Integer (State PState) (LocSymbol, RISig (Located BareType))
-> ParsecT
     String Integer (State PState) (LocSymbol, RISig (Located BareType))
-> ParsecT
     String Integer (State PState) (LocSymbol, RISig (Located BareType))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do (LocSymbol
x, Located BareType
t) <- ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP
        (LocSymbol, RISig (Located BareType))
-> ParsecT
     String Integer (State PState) (LocSymbol, RISig (Located BareType))
forall (m :: * -> *) a. Monad m => a -> m a
return (LocSymbol
x, Located BareType -> RISig (Located BareType)
forall t. t -> RISig t
RISig Located BareType
t)
 ParsecT
  String Integer (State PState) (LocSymbol, RISig (Located BareType))
-> String
-> ParsecT
     String Integer (State PState) (LocSymbol, RISig (Located BareType))
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"riMethodSigP"

classP :: Parser (RClass (Located BareType))
classP :: ParsecT String Integer (State PState) (RClass (Located BareType))
classP
  = do [Located BareType]
sups <- ParsecT String Integer (State PState) [Located BareType]
supersP
       BTyCon
c    <- ParsecT String Integer (State PState) BTyCon
classBTyConP
       Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
       [BTyVar]
tvs  <- ParsecT String Integer (State PState) BTyVar
-> Parser () -> Parser [BTyVar]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill (Symbol -> BTyVar
bTyVar (Symbol -> BTyVar)
-> Parser Symbol -> ParsecT String Integer (State PState) BTyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
tyVarIdP) (Parser () -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
reserved String
"where")
       [(LocSymbol, Located BareType)]
ms   <- ParsecT
  String Integer (State PState) [(LocSymbol, Located BareType)]
-> ParsecT
     String Integer (State PState) [(LocSymbol, Located BareType)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String Integer (State PState) (LocSymbol, Located BareType)
-> ParsecT
     String Integer (State PState) [(LocSymbol, Located BareType)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
grabs ParsecT String Integer (State PState) (LocSymbol, Located BareType)
tyBindP) -- <|> sepBy tyBindP semi
       Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
       RClass (Located BareType)
-> ParsecT
     String Integer (State PState) (RClass (Located BareType))
forall (m :: * -> *) a. Monad m => a -> m a
return (RClass (Located BareType)
 -> ParsecT
      String Integer (State PState) (RClass (Located BareType)))
-> RClass (Located BareType)
-> ParsecT
     String Integer (State PState) (RClass (Located BareType))
forall a b. (a -> b) -> a -> b
$ BTyCon
-> [Located BareType]
-> [BTyVar]
-> [(LocSymbol, Located BareType)]
-> RClass (Located BareType)
forall ty.
BTyCon -> [ty] -> [BTyVar] -> [(LocSymbol, ty)] -> RClass ty
RClass BTyCon
c [Located BareType]
sups [BTyVar]
tvs [(LocSymbol, Located BareType)]
ms
  where
    superP :: ParsecT String Integer (State PState) (Located BareType)
superP   = ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Located BareType)
forall a. Parser a -> Parser (Located a)
locParserP (BareType -> BareType
forall a. a -> a
toRCls (BareType -> BareType)
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) BareType
bareAtomBindP)
    supersP :: ParsecT String Integer (State PState) [Located BareType]
supersP  = ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (((ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall u a. ParserT u a -> ParserT u a
parens (ParsecT String Integer (State PState) (Located BareType)
superP ParsecT String Integer (State PState) (Located BareType)
-> Parser String
-> ParsecT String Integer (State PState) [Located BareType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` Parser String
comma)) ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Located BareType -> [Located BareType])
-> ParsecT String Integer (State PState) (Located BareType)
-> ParsecT String Integer (State PState) [Located BareType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located BareType -> [Located BareType]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParsecT String Integer (State PState) (Located BareType)
superP)
                       ParsecT String Integer (State PState) [Located BareType]
-> Parser ()
-> ParsecT String Integer (State PState) [Located BareType]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser ()
reservedOp String
"=>")
               ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [Located BareType]
-> ParsecT String Integer (State PState) [Located BareType]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    toRCls :: p -> p
toRCls p
x = p
x

rawBodyP :: Parser Body
rawBodyP :: Parser Body
rawBodyP
  = Parser Body -> Parser Body
forall u a. ParserT u a -> ParserT u a
braces (Parser Body -> Parser Body) -> Parser Body -> Parser Body
forall a b. (a -> b) -> a -> b
$ do
      Symbol
v <- Parser Symbol
symbolP
      String -> Parser ()
reservedOp String
"|"
      Expr
p <- Parser Expr
predP Parser Expr -> Parser () -> Parser Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
      Body -> Parser Body
forall (m :: * -> *) a. Monad m => a -> m a
return (Body -> Parser Body) -> Body -> Parser Body
forall a b. (a -> b) -> a -> b
$ Symbol -> Expr -> Body
R Symbol
v Expr
p

tyBodyP :: Located BareType -> Parser Body
tyBodyP :: Located BareType -> Parser Body
tyBodyP Located BareType
ty
  = case BareType -> Maybe BareType
forall c tv r. RType c tv r -> Maybe (RType c tv r)
outTy (Located BareType -> BareType
forall a. Located a -> a
val Located BareType
ty) of
      Just BareType
bt | BareType -> Bool
forall t t1. RType BTyCon t t1 -> Bool
isPropBareType BareType
bt
                -> Expr -> Body
P (Expr -> Body) -> Parser Expr -> Parser Body
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr
predP
      Maybe BareType
_         -> Expr -> Body
E (Expr -> Body) -> Parser Expr -> Parser Body
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Expr
exprP
    where outTy :: RType c tv r -> Maybe (RType c tv r)
outTy (RAllT RTVU c tv
_ RType c tv r
t r
_)  = RType c tv r -> Maybe (RType c tv r)
outTy RType c tv r
t
          outTy (RAllP PVU c tv
_ RType c tv r
t)    = RType c tv r -> Maybe (RType c tv r)
outTy RType c tv r
t
          outTy (RImpF Symbol
_ RType c tv r
_ RType c tv r
t r
_)= RType c tv r -> Maybe (RType c tv r)
forall a. a -> Maybe a
Just RType c tv r
t
          outTy (RFun Symbol
_ RType c tv r
_ RType c tv r
t r
_) = RType c tv r -> Maybe (RType c tv r)
forall a. a -> Maybe a
Just RType c tv r
t
          outTy RType c tv r
_              = Maybe (RType c tv r)
forall a. Maybe a
Nothing

locUpperIdP' :: Parser (Located Symbol)
locUpperIdP' :: ParsecT String Integer (State PState) LocSymbol
locUpperIdP' = Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
upperIdP'

upperIdP' :: Parser Symbol
upperIdP' :: Parser Symbol
upperIdP' = Parser Symbol -> Parser Symbol
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Symbol -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Symbol -> Symbol) -> Parser Symbol -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Bool) -> Parser Symbol
condIdP' (Char -> Bool
isUpper (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. [a] -> a
head))
        Parser Symbol -> Parser Symbol -> Parser Symbol
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Symbol -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Symbol -> Symbol) -> Parser Symbol -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
infixCondIdP')

-- TODO:AZ this looks dodgy, rather use reserved, reservedOp
condIdP'  :: (String -> Bool) -> Parser Symbol
condIdP' :: (String -> Bool) -> Parser Symbol
condIdP' String -> Bool
f
  = do Char
c  <- ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
       let isAlphaNumOr' :: Char -> Bool
isAlphaNumOr' Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| (Char
'\''Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
       String
cs <- ParsecT String Integer (State PState) Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isAlphaNumOr')
       Parser String
blanks
       if String -> Bool
f (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs) then Symbol -> Parser Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Text -> Symbol) -> Text -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs) else Parser Symbol
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero

infixCondIdP' :: Parser Symbol
infixCondIdP' :: Parser Symbol
infixCondIdP'
  = do Symbol
sym <- Parser Symbol -> Parser Symbol
forall u a. ParserT u a -> ParserT u a
parens (Parser Symbol -> Parser Symbol) -> Parser Symbol -> Parser Symbol
forall a b. (a -> b) -> a -> b
$ do
         String
c1 <- Parser String
colon
         -- This is the same thing as 'startsVarSymASCII' from ghc-boot-th,
         -- but LH can't use that at the moment since it requires GHC 7.10.
         let isASCIISymbol :: Char -> Bool
isASCIISymbol = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"!#$%&*+./<=>?@\\^|~-" :: String))
         String
ss <- ParsecT String Integer (State PState) Char -> Parser String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((Char -> Bool) -> ParsecT String Integer (State PState) Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isASCIISymbol)
         String
c2 <- Parser String
colon
         Symbol -> Parser Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return (Symbol -> Parser Symbol) -> Symbol -> Parser Symbol
forall a b. (a -> b) -> a -> b
$ Text -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Text -> Symbol) -> Text -> Symbol
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
c1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ss String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c2
       Parser String
blanks
       Symbol -> Parser Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
sym

-- | LHS of the thing being defined
binderP :: Parser Symbol
binderP :: Parser Symbol
binderP    = String -> Symbol
forall a. (Symbolic a, Monoid a, IsString a) => a -> Symbol
pwr    (String -> Symbol) -> Parser String -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser String
forall u a. ParserT u a -> ParserT u a
parens ((Char -> Bool) -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m String
idP Char -> Bool
bad)
         Parser Symbol -> Parser Symbol -> Parser Symbol
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (String -> Symbol) -> Parser String -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m String
idP Char -> Bool
badc
  where
    idP :: (Char -> Bool) -> ParsecT s u m String
idP Char -> Bool
p  = ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p))
    badc :: Char -> Bool
badc Char
c = (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Bool -> Bool -> Bool
|| Char -> Bool
bad Char
c
    bad :: Char -> Bool
bad Char
c  = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"(,)[]" :: String)
    pwr :: a -> Symbol
pwr a
s  = a -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (a -> Symbol) -> a -> Symbol
forall a b. (a -> b) -> a -> b
$ a
"(" a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
s a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
")"


grabs :: ParsecT s u m a -> ParsecT s u m [a]
grabs :: ParsecT s u m a -> ParsecT s u m [a]
grabs ParsecT s u m a
p = ParsecT s u m [a] -> ParsecT s u m [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((a -> [a] -> [a])
-> ParsecT s u m a -> ParsecT s u m [a] -> ParsecT s u m [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ParsecT s u m a
p (ParsecT s u m a -> ParsecT s u m [a]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
grabs ParsecT s u m a
p))
       ParsecT s u m [a] -> ParsecT s u m [a] -> ParsecT s u m [a]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [a] -> ParsecT s u m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

measureDefP :: Parser Body -> Parser (Def (Located BareType) LocSymbol)
measureDefP :: Parser Body
-> ParsecT
     String Integer (State PState) (Def (Located BareType) LocSymbol)
measureDefP Parser Body
bodyP
  = do LocSymbol
mname   <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
symbolP
       (LocSymbol
c, [LocSymbol]
xs) <- ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
measurePatP
       Parser ()
whiteSpace Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser ()
reservedOp String
"=" Parser () -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
whiteSpace
       Body
body    <- Parser Body
bodyP
       Parser ()
whiteSpace
       let xs' :: [Symbol]
xs'  = (Symbol -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Symbol -> Symbol) -> (LocSymbol -> Symbol) -> LocSymbol -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocSymbol -> Symbol
forall a. Located a -> a
val) (LocSymbol -> Symbol) -> [LocSymbol] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocSymbol]
xs
       Def (Located BareType) LocSymbol
-> ParsecT
     String Integer (State PState) (Def (Located BareType) LocSymbol)
forall (m :: * -> *) a. Monad m => a -> m a
return   (Def (Located BareType) LocSymbol
 -> ParsecT
      String Integer (State PState) (Def (Located BareType) LocSymbol))
-> Def (Located BareType) LocSymbol
-> ParsecT
     String Integer (State PState) (Def (Located BareType) LocSymbol)
forall a b. (a -> b) -> a -> b
$ LocSymbol
-> LocSymbol
-> Maybe (Located BareType)
-> [(Symbol, Maybe (Located BareType))]
-> Body
-> Def (Located BareType) LocSymbol
forall ty ctor.
LocSymbol
-> ctor -> Maybe ty -> [(Symbol, Maybe ty)] -> Body -> Def ty ctor
Def LocSymbol
mname (Symbol -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (Symbol -> Symbol) -> LocSymbol -> LocSymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocSymbol
c) Maybe (Located BareType)
forall a. Maybe a
Nothing ((, Maybe (Located BareType)
forall a. Maybe a
Nothing) (Symbol -> (Symbol, Maybe (Located BareType)))
-> [Symbol] -> [(Symbol, Maybe (Located BareType))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
xs') Body
body

measurePatP :: Parser (LocSymbol, [LocSymbol])
measurePatP :: ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
measurePatP
  =  ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall u a. ParserT u a -> ParserT u a
parens (ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
conPatP ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall a. IsString a => Parser (Located a, [LocSymbol])
consPatP ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall a t. IsString a => Parser (Located a, [t])
nilPatP ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
tupPatP)
 ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall t. Parser (LocSymbol, [t])
nullaryConPatP
 ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
-> String
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"measurePatP"

tupPatP :: Parser (Located Symbol, [Located Symbol])
tupPatP :: ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
tupPatP  = [LocSymbol] -> (LocSymbol, [LocSymbol])
forall (t :: * -> *) a. Foldable t => t a -> (LocSymbol, t a)
mkTupPat  ([LocSymbol] -> (LocSymbol, [LocSymbol]))
-> ParsecT String Integer (State PState) [LocSymbol]
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) LocSymbol
-> Parser String
-> ParsecT String Integer (State PState) [LocSymbol]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT String Integer (State PState) LocSymbol
locLowerIdP Parser String
comma

conPatP :: Parser (Located Symbol, [Located Symbol])
conPatP :: ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
conPatP  = (,)       (LocSymbol -> [LocSymbol] -> (LocSymbol, [LocSymbol]))
-> ParsecT String Integer (State PState) LocSymbol
-> ParsecT
     String
     Integer
     (State PState)
     ([LocSymbol] -> (LocSymbol, [LocSymbol]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
dataConNameP ParsecT
  String
  Integer
  (State PState)
  ([LocSymbol] -> (LocSymbol, [LocSymbol]))
-> ParsecT String Integer (State PState) [LocSymbol]
-> ParsecT String Integer (State PState) (LocSymbol, [LocSymbol])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String Integer (State PState) LocSymbol
-> Parser () -> ParsecT String Integer (State PState) [LocSymbol]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String Integer (State PState) LocSymbol
locLowerIdP Parser ()
whiteSpace

consPatP :: IsString a
         => Parser (Located a, [Located Symbol])
consPatP :: Parser (Located a, [LocSymbol])
consPatP = LocSymbol -> String -> LocSymbol -> (Located a, [LocSymbol])
forall a t1 t. IsString a => t1 -> t -> t1 -> (Located a, [t1])
mkConsPat (LocSymbol -> String -> LocSymbol -> (Located a, [LocSymbol]))
-> ParsecT String Integer (State PState) LocSymbol
-> ParsecT
     String
     Integer
     (State PState)
     (String -> LocSymbol -> (Located a, [LocSymbol]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) LocSymbol
locLowerIdP  ParsecT
  String
  Integer
  (State PState)
  (String -> LocSymbol -> (Located a, [LocSymbol]))
-> Parser String
-> ParsecT
     String
     Integer
     (State PState)
     (LocSymbol -> (Located a, [LocSymbol]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
colon ParsecT
  String
  Integer
  (State PState)
  (LocSymbol -> (Located a, [LocSymbol]))
-> ParsecT String Integer (State PState) LocSymbol
-> Parser (Located a, [LocSymbol])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String Integer (State PState) LocSymbol
locLowerIdP

nilPatP :: IsString a
        => Parser (Located a, [t])
nilPatP :: Parser (Located a, [t])
nilPatP  = () -> (Located a, [t])
forall a t t1. IsString a => t -> (Located a, [t1])
mkNilPat  (() -> (Located a, [t])) -> Parser () -> Parser (Located a, [t])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser ()
forall u a. ParserT u a -> ParserT u a
brackets Parser ()
whiteSpace

nullaryConPatP :: Parser (Located Symbol, [t])
nullaryConPatP :: Parser (LocSymbol, [t])
nullaryConPatP = Parser (LocSymbol, [t])
forall a t. IsString a => Parser (Located a, [t])
nilPatP Parser (LocSymbol, [t])
-> Parser (LocSymbol, [t]) -> Parser (LocSymbol, [t])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((,[]) (LocSymbol -> (LocSymbol, [t]))
-> ParsecT String Integer (State PState) LocSymbol
-> Parser (LocSymbol, [t])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
dataConNameP)
                 Parser (LocSymbol, [t]) -> String -> Parser (LocSymbol, [t])
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"nullaryConPatP"

mkTupPat :: Foldable t => t a -> (Located Symbol, t a)
mkTupPat :: t a -> (LocSymbol, t a)
mkTupPat t a
zs     = (Line -> LocSymbol
tupDataCon (t a -> Line
forall (t :: * -> *) a. Foldable t => t a -> Line
length t a
zs), t a
zs)

mkNilPat :: IsString a => t -> (Located a, [t1])
mkNilPat :: t -> (Located a, [t1])
mkNilPat t
_      = (a -> Located a
forall a. a -> Located a
dummyLoc a
"[]", []    )

mkConsPat :: IsString a => t1 -> t -> t1 -> (Located a, [t1])
mkConsPat :: t1 -> t -> t1 -> (Located a, [t1])
mkConsPat t1
x t
_ t1
y = (a -> Located a
forall a. a -> Located a
dummyLoc a
":" , [t1
x, t1
y])

tupDataCon :: Int -> Located Symbol
tupDataCon :: Line -> LocSymbol
tupDataCon Line
n    = Symbol -> LocSymbol
forall a. a -> Located a
dummyLoc (Symbol -> LocSymbol) -> Symbol -> LocSymbol
forall a b. (a -> b) -> a -> b
$ String -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (String -> Symbol) -> String -> Symbol
forall a b. (a -> b) -> a -> b
$ String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Line -> Char -> String
forall a. Line -> a -> [a]
replicate (Line
n Line -> Line -> Line
forall a. Num a => a -> a -> a
- Line
1) Char
',' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"


-------------------------------------------------------------------------------
--------------------------------- Predicates ----------------------------------
-------------------------------------------------------------------------------

dataConFieldsP :: Parser [(Symbol, BareType)]
dataConFieldsP :: ParsecT String Integer (State PState) [(Symbol, BareType)]
dataConFieldsP
   =  ParsecT String Integer (State PState) [(Symbol, BareType)]
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
forall u a. ParserT u a -> ParserT u a
braces (ParsecT String Integer (State PState) (Symbol, BareType)
-> Parser String
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String Integer (State PState) (Symbol, BareType)
predTypeDDP Parser String
comma)
  ParsecT String Integer (State PState) [(Symbol, BareType)]
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (Symbol, BareType)
-> Parser ()
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String Integer (State PState) (Symbol, BareType)
dataConFieldP Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  ParsecT String Integer (State PState) [(Symbol, BareType)]
-> String
-> ParsecT String Integer (State PState) [(Symbol, BareType)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"dataConFieldP"

dataConFieldP :: Parser (Symbol, BareType)
dataConFieldP :: ParsecT String Integer (State PState) (Symbol, BareType)
dataConFieldP
   =  ParsecT String Integer (State PState) (Symbol, BareType)
-> ParsecT String Integer (State PState) (Symbol, BareType)
forall u a. ParserT u a -> ParserT u a
parens (ParsecT String Integer (State PState) (Symbol, BareType)
-> ParsecT String Integer (State PState) (Symbol, BareType)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String Integer (State PState) (Symbol, BareType)
predTypeDDP ParsecT String Integer (State PState) (Symbol, BareType)
-> ParsecT String Integer (State PState) (Symbol, BareType)
-> ParsecT String Integer (State PState) (Symbol, BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (Symbol, BareType)
dbTypeP)
  ParsecT String Integer (State PState) (Symbol, BareType)
-> ParsecT String Integer (State PState) (Symbol, BareType)
-> ParsecT String Integer (State PState) (Symbol, BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String Integer (State PState) (Symbol, BareType)
dbTypeP
  ParsecT String Integer (State PState) (Symbol, BareType)
-> String
-> ParsecT String Integer (State PState) (Symbol, BareType)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"dataConFieldP"
  where
    dbTypeP :: ParsecT String Integer (State PState) (Symbol, BareType)
dbTypeP = (,) (Symbol -> BareType -> (Symbol, BareType))
-> Parser Symbol
-> ParsecT
     String Integer (State PState) (BareType -> (Symbol, BareType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
dummyBindP ParsecT
  String Integer (State PState) (BareType -> (Symbol, BareType))
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Symbol, BareType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String Integer (State PState) BareType
bareTypeP

predTypeDDP :: Parser (Symbol, BareType)
predTypeDDP :: ParsecT String Integer (State PState) (Symbol, BareType)
predTypeDDP = (,) (Symbol -> BareType -> (Symbol, BareType))
-> Parser Symbol
-> ParsecT
     String Integer (State PState) (BareType -> (Symbol, BareType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol
bbindP ParsecT
  String Integer (State PState) (BareType -> (Symbol, BareType))
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Symbol, BareType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String Integer (State PState) BareType
bareTypeP

bbindP   :: Parser Symbol
bbindP :: Parser Symbol
bbindP   = Parser Symbol
lowerIdP Parser Symbol -> Parser String -> Parser Symbol
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser String
dcolon

dataConP :: [Symbol] -> Parser DataCtor
dataConP :: [Symbol] -> Parser DataCtor
dataConP [Symbol]
as = do
  LocSymbol
x   <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
dataConNameP
  Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  [(Symbol, BareType)]
xts <- ParsecT String Integer (State PState) [(Symbol, BareType)]
dataConFieldsP
  DataCtor -> Parser DataCtor
forall (m :: * -> *) a. Monad m => a -> m a
return (DataCtor -> Parser DataCtor) -> DataCtor -> Parser DataCtor
forall a b. (a -> b) -> a -> b
$ LocSymbol
-> [Symbol]
-> [BareType]
-> [(Symbol, BareType)]
-> Maybe BareType
-> DataCtor
DataCtor LocSymbol
x [Symbol]
as [] [(Symbol, BareType)]
xts Maybe BareType
forall a. Maybe a
Nothing

adtDataConP :: [Symbol] -> Parser DataCtor
adtDataConP :: [Symbol] -> Parser DataCtor
adtDataConP [Symbol]
as = do
  LocSymbol
x     <- Parser Symbol -> ParsecT String Integer (State PState) LocSymbol
forall a. Parser a -> Parser (Located a)
locParserP Parser Symbol
dataConNameP
  Parser String
dcolon
  RTypeRep BTyCon BTyVar RReft
tr    <- BareType -> RTypeRep BTyCon BTyVar RReft
forall c tv r. RType c tv r -> RTypeRep c tv r
toRTypeRep (BareType -> RTypeRep BTyCon BTyVar RReft)
-> ParsecT String Integer (State PState) BareType
-> ParsecT
     String Integer (State PState) (RTypeRep BTyCon BTyVar RReft)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) BareType
bareTypeP
  DataCtor -> Parser DataCtor
forall (m :: * -> *) a. Monad m => a -> m a
return (DataCtor -> Parser DataCtor) -> DataCtor -> Parser DataCtor
forall a b. (a -> b) -> a -> b
$ LocSymbol
-> [Symbol]
-> [BareType]
-> [(Symbol, BareType)]
-> Maybe BareType
-> DataCtor
DataCtor LocSymbol
x ([Symbol] -> RTypeRep BTyCon BTyVar RReft -> [Symbol]
forall a c r. Symbolic a => [Symbol] -> RTypeRep c a r -> [Symbol]
tRepVars [Symbol]
as RTypeRep BTyCon BTyVar RReft
tr) [] (RTypeRep BTyCon BTyVar RReft -> [(Symbol, BareType)]
forall c tv r. RTypeRep c tv r -> [(Symbol, RType c tv r)]
tRepFields RTypeRep BTyCon BTyVar RReft
tr) (BareType -> Maybe BareType
forall a. a -> Maybe a
Just (BareType -> Maybe BareType) -> BareType -> Maybe BareType
forall a b. (a -> b) -> a -> b
$ RTypeRep BTyCon BTyVar RReft -> BareType
forall c tv r. RTypeRep c tv r -> RType c tv r
ty_res RTypeRep BTyCon BTyVar RReft
tr)

tRepVars :: Symbolic a => [Symbol] -> RTypeRep c a r -> [Symbol]
tRepVars :: [Symbol] -> RTypeRep c a r -> [Symbol]
tRepVars [Symbol]
as RTypeRep c a r
tr = case (RTVar a (RType c a ()), r) -> RTVar a (RType c a ())
forall a b. (a, b) -> a
fst ((RTVar a (RType c a ()), r) -> RTVar a (RType c a ()))
-> [(RTVar a (RType c a ()), r)] -> [RTVar a (RType c a ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RTypeRep c a r -> [(RTVar a (RType c a ()), r)]
forall c tv r. RTypeRep c tv r -> [(RTVar tv (RType c tv ()), r)]
ty_vars RTypeRep c a r
tr of 
  [] -> [Symbol]
as 
  [RTVar a (RType c a ())]
vs -> a -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (a -> Symbol)
-> (RTVar a (RType c a ()) -> a)
-> RTVar a (RType c a ())
-> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RTVar a (RType c a ()) -> a
forall tv s. RTVar tv s -> tv
ty_var_value (RTVar a (RType c a ()) -> Symbol)
-> [RTVar a (RType c a ())] -> [Symbol]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RTVar a (RType c a ())]
vs 

tRepFields :: RTypeRep c tv r -> [(Symbol, RType c tv r)]
tRepFields :: RTypeRep c tv r -> [(Symbol, RType c tv r)]
tRepFields RTypeRep c tv r
tr = [Symbol] -> [RType c tv r] -> [(Symbol, RType c tv r)]
forall a b. [a] -> [b] -> [(a, b)]
zip (RTypeRep c tv r -> [Symbol]
forall c tv r. RTypeRep c tv r -> [Symbol]
ty_binds RTypeRep c tv r
tr) (RTypeRep c tv r -> [RType c tv r]
forall c tv r. RTypeRep c tv r -> [RType c tv r]
ty_args RTypeRep c tv r
tr)

dataConNameP :: Parser Symbol
dataConNameP :: Parser Symbol
dataConNameP
  =  Parser Symbol -> Parser Symbol
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Symbol
upperIdP
 Parser Symbol -> Parser Symbol -> Parser Symbol
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> Symbol
forall a. (Symbolic a, Semigroup a, IsString a) => a -> Symbol
pwr (String -> Symbol) -> Parser String -> Parser Symbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser String
forall u a. ParserT u a -> ParserT u a
parens ((Char -> Bool) -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m String
idP Char -> Bool
bad)
 Parser Symbol -> String -> Parser Symbol
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"dataConNameP"
  where
     idP :: (Char -> Bool) -> ParsecT s u m String
idP Char -> Bool
p  = ParsecT s u m Char -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p))
     bad :: Char -> Bool
bad Char
c  = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"(,)" :: String)
     pwr :: a -> Symbol
pwr a
s  = a -> Symbol
forall a. Symbolic a => a -> Symbol
symbol (a -> Symbol) -> a -> Symbol
forall a b. (a -> b) -> a -> b
$ a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"

dataSizeP :: Parser (Maybe SizeFun)
dataSizeP :: Parser (Maybe SizeFun)
dataSizeP
  = Parser (Maybe SizeFun) -> Parser (Maybe SizeFun)
forall u a. ParserT u a -> ParserT u a
brackets (SizeFun -> Maybe SizeFun
forall a. a -> Maybe a
Just (SizeFun -> Maybe SizeFun)
-> (LocSymbol -> SizeFun) -> LocSymbol -> Maybe SizeFun
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocSymbol -> SizeFun
SymSizeFun (LocSymbol -> Maybe SizeFun)
-> ParsecT String Integer (State PState) LocSymbol
-> Parser (Maybe SizeFun)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) LocSymbol
locLowerIdP)
  Parser (Maybe SizeFun)
-> Parser (Maybe SizeFun) -> Parser (Maybe SizeFun)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe SizeFun -> Parser (Maybe SizeFun)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SizeFun
forall a. Maybe a
Nothing

dataDeclP :: Parser DataDecl
dataDeclP :: ParsecT String Integer (State PState) DataDecl
dataDeclP = do
  SourcePos
pos <- ParsecT String Integer (State PState) SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  LocSymbol
x   <- ParsecT String Integer (State PState) LocSymbol
locUpperIdP'
  Parser ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
  Maybe SizeFun
fsize <- Parser (Maybe SizeFun)
dataSizeP
  (SourcePos
-> LocSymbol
-> Maybe SizeFun
-> ParsecT String Integer (State PState) DataDecl
dataDeclBodyP SourcePos
pos LocSymbol
x Maybe SizeFun
fsize ParsecT String Integer (State PState) DataDecl
-> ParsecT String Integer (State PState) DataDecl
-> ParsecT String Integer (State PState) DataDecl
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> DataDecl -> ParsecT String Integer (State PState) DataDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (LocSymbol -> SourcePos -> Maybe SizeFun -> DataDecl
emptyDecl LocSymbol
x SourcePos
pos Maybe SizeFun
fsize))

emptyDecl :: LocSymbol -> SourcePos -> Maybe SizeFun -> DataDecl
emptyDecl :: LocSymbol -> SourcePos -> Maybe SizeFun -> DataDecl
emptyDecl LocSymbol
x SourcePos
pos fsize :: Maybe SizeFun
fsize@(Just SizeFun
_)
  = DataName
-> [Symbol]
-> [PVar (RType BTyCon BTyVar ())]
-> [DataCtor]
-> SourcePos
-> Maybe SizeFun
-> Maybe BareType
-> DataDeclKind
-> DataDecl
DataDecl (LocSymbol -> DataName
DnName LocSymbol
x) [] [] [] SourcePos
pos Maybe SizeFun
fsize Maybe BareType
forall a. Maybe a
Nothing DataDeclKind
DataUser
emptyDecl LocSymbol
x SourcePos
pos Maybe SizeFun
_
  = UserError -> DataDecl
forall a. UserError -> a
uError (SrcSpan -> Doc -> Doc -> UserError
forall t. SrcSpan -> Doc -> Doc -> TError t
ErrBadData (SourcePos -> SrcSpan
sourcePosSrcSpan SourcePos
pos) (Symbol -> Doc
forall a. PPrint a => a -> Doc
pprint (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
x)) Doc
forall a. IsString a => a
msg)
  where
    msg :: p
msg = p
"You should specify either a default [size] or one or more fields in the data declaration"

dataDeclBodyP :: SourcePos -> LocSymbol -> Maybe SizeFun -> Parser DataDecl
dataDeclBodyP :: SourcePos
-> LocSymbol
-> Maybe SizeFun
-> ParsecT String Integer (State PState) DataDecl
dataDeclBodyP SourcePos
pos LocSymbol
x Maybe SizeFun
fsize = do
  Bool
vanilla    <- [LocSymbol] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LocSymbol] -> Bool)
-> ParsecT String Integer (State PState) [LocSymbol]
-> ParsecT String Integer (State PState) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) LocSymbol
-> Parser String
-> ParsecT String Integer (State PState) [LocSymbol]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT String Integer (State PState) LocSymbol
locUpperIdP Parser String
blanks
  [Symbol]
as         <- Parser Symbol
-> Parser String -> ParsecT String Integer (State PState) [Symbol]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy Parser Symbol
noWhere Parser String
blanks
  [PVar (RType BTyCon BTyVar ())]
ps         <- Parser [PVar (RType BTyCon BTyVar ())]
predVarDefsP
  (Maybe BareType
pTy, [DataCtor]
dcs) <- [Symbol] -> Parser (Maybe BareType, [DataCtor])
dataCtorsP [Symbol]
as
  let dn :: DataName
dn      = SourcePos -> LocSymbol -> Bool -> [DataCtor] -> DataName
dataDeclName SourcePos
pos LocSymbol
x Bool
vanilla [DataCtor]
dcs
  Parser ()
whiteSpace
  DataDecl -> ParsecT String Integer (State PState) DataDecl
forall (m :: * -> *) a. Monad m => a -> m a
return      (DataDecl -> ParsecT String Integer (State PState) DataDecl)
-> DataDecl -> ParsecT String Integer (State PState) DataDecl
forall a b. (a -> b) -> a -> b
$ DataName
-> [Symbol]
-> [PVar (RType BTyCon BTyVar ())]
-> [DataCtor]
-> SourcePos
-> Maybe SizeFun
-> Maybe BareType
-> DataDeclKind
-> DataDecl
DataDecl DataName
dn [Symbol]
as [PVar (RType BTyCon BTyVar ())]
ps [DataCtor]
dcs SourcePos
pos Maybe SizeFun
fsize Maybe BareType
pTy DataDeclKind
DataUser

dataDeclName :: SourcePos -> LocSymbol -> Bool -> [DataCtor] -> DataName
dataDeclName :: SourcePos -> LocSymbol -> Bool -> [DataCtor] -> DataName
dataDeclName SourcePos
_ LocSymbol
x Bool
True  [DataCtor]
_     = LocSymbol -> DataName
DnName LocSymbol
x               -- vanilla data    declaration
dataDeclName SourcePos
_ LocSymbol
_ Bool
False (DataCtor
d:[DataCtor]
_) = LocSymbol -> DataName
DnCon  (DataCtor -> LocSymbol
dcName DataCtor
d)      -- family instance declaration
dataDeclName SourcePos
p LocSymbol
x Bool
_  [DataCtor]
_        = UserError -> DataName
forall a. UserError -> a
uError (SrcSpan -> Doc -> Doc -> UserError
forall t. SrcSpan -> Doc -> Doc -> TError t
ErrBadData (SourcePos -> SrcSpan
sourcePosSrcSpan SourcePos
p) (Symbol -> Doc
forall a. PPrint a => a -> Doc
pprint (LocSymbol -> Symbol
forall a. Located a -> a
val LocSymbol
x)) Doc
forall a. IsString a => a
msg)
  where
    msg :: p
msg                  = p
"You should specify at least one data constructor for a family instance"

dataCtorsP :: [Symbol] -> Parser (Maybe BareType, [DataCtor])
dataCtorsP :: [Symbol] -> Parser (Maybe BareType, [DataCtor])
dataCtorsP [Symbol]
as = do
  (Maybe BareType
pTy, [DataCtor]
dcs) <-     (String -> Parser ()
reservedOp String
"="     Parser ()
-> Parser (Maybe BareType, [DataCtor])
-> Parser (Maybe BareType, [DataCtor])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Maybe BareType
forall a. Maybe a
Nothing, ) ([DataCtor] -> (Maybe BareType, [DataCtor]))
-> ParsecT String Integer (State PState) [DataCtor]
-> Parser (Maybe BareType, [DataCtor])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>                 Parser DataCtor
-> Parser () -> ParsecT String Integer (State PState) [DataCtor]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ([Symbol] -> Parser DataCtor
dataConP    [Symbol]
as) (String -> Parser ()
reservedOp String
"|")))
                Parser (Maybe BareType, [DataCtor])
-> Parser (Maybe BareType, [DataCtor])
-> Parser (Maybe BareType, [DataCtor])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved   String
"where" Parser ()
-> Parser (Maybe BareType, [DataCtor])
-> Parser (Maybe BareType, [DataCtor])
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Maybe BareType
forall a. Maybe a
Nothing, ) ([DataCtor] -> (Maybe BareType, [DataCtor]))
-> ParsecT String Integer (State PState) [DataCtor]
-> Parser (Maybe BareType, [DataCtor])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>                 Parser DataCtor
-> Parser () -> ParsecT String Integer (State PState) [DataCtor]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ([Symbol] -> Parser DataCtor
adtDataConP [Symbol]
as) (String -> Parser ()
reservedOp String
"|")))
                Parser (Maybe BareType, [DataCtor])
-> Parser (Maybe BareType, [DataCtor])
-> Parser (Maybe BareType, [DataCtor])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (                      ((,)         (Maybe BareType -> [DataCtor] -> (Maybe BareType, [DataCtor]))
-> ParsecT String Integer (State PState) (Maybe BareType)
-> ParsecT
     String
     Integer
     (State PState)
     ([DataCtor] -> (Maybe BareType, [DataCtor]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) (Maybe BareType)
dataPropTyP ParsecT
  String
  Integer
  (State PState)
  ([DataCtor] -> (Maybe BareType, [DataCtor]))
-> ParsecT String Integer (State PState) [DataCtor]
-> Parser (Maybe BareType, [DataCtor])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DataCtor
-> Parser () -> ParsecT String Integer (State PState) [DataCtor]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ([Symbol] -> Parser DataCtor
adtDataConP [Symbol]
as) (String -> Parser ()
reservedOp String
"|")))
  (Maybe BareType, [DataCtor]) -> Parser (Maybe BareType, [DataCtor])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BareType
pTy, (DataCtor -> Symbol) -> [DataCtor] -> [DataCtor]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Misc.sortOn (LocSymbol -> Symbol
forall a. Located a -> a
val (LocSymbol -> Symbol)
-> (DataCtor -> LocSymbol) -> DataCtor -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCtor -> LocSymbol
dcName) [DataCtor]
dcs)

noWhere :: Parser Symbol
noWhere :: Parser Symbol
noWhere = 
  Parser Symbol -> Parser Symbol
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser Symbol -> Parser Symbol) -> Parser Symbol -> Parser Symbol
forall a b. (a -> b) -> a -> b
$ do
  Symbol
s <- Parser Symbol
tyVarIdP
  if Symbol
s Symbol -> Symbol -> Bool
forall a. Eq a => a -> a -> Bool
== Symbol
"where"
    then Parser Symbol
forall s u (m :: * -> *) a. ParsecT s u m a
parserZero
    else Symbol -> Parser Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol
s

dataPropTyP :: Parser (Maybe BareType)
dataPropTyP :: ParsecT String Integer (State PState) (Maybe BareType)
dataPropTyP = BareType -> Maybe BareType
forall a. a -> Maybe a
Just (BareType -> Maybe BareType)
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) (Maybe BareType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
-> Parser ()
-> ParsecT String Integer (State PState) BareType
-> ParsecT String Integer (State PState) BareType
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between Parser String
dcolon (String -> Parser ()
reserved String
"where") ParsecT String Integer (State PState) BareType
bareTypeP

---------------------------------------------------------------------
-- | Parsing Qualifiers ---------------------------------------------
---------------------------------------------------------------------

fTyConP :: Parser FTycon
fTyConP :: Parser FTycon
fTyConP
  =   (String -> Parser ()
reserved String
"int"     Parser () -> Parser FTycon -> Parser FTycon
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FTycon -> Parser FTycon
forall (m :: * -> *) a. Monad m => a -> m a
return FTycon
intFTyCon)
  Parser FTycon -> Parser FTycon -> Parser FTycon
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"Integer" Parser () -> Parser FTycon -> Parser FTycon
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FTycon -> Parser FTycon
forall (m :: * -> *) a. Monad m => a -> m a
return FTycon
intFTyCon)
  Parser FTycon -> Parser FTycon -> Parser FTycon
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"Int"     Parser () -> Parser FTycon -> Parser FTycon
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FTycon -> Parser FTycon
forall (m :: * -> *) a. Monad m => a -> m a
return FTycon
intFTyCon)
  Parser FTycon -> Parser FTycon -> Parser FTycon
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"real"    Parser () -> Parser FTycon -> Parser FTycon
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FTycon -> Parser FTycon
forall (m :: * -> *) a. Monad m => a -> m a
return FTycon
realFTyCon)
  Parser FTycon -> Parser FTycon -> Parser FTycon
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> Parser ()
reserved String
"bool"    Parser () -> Parser FTycon -> Parser FTycon
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FTycon -> Parser FTycon
forall (m :: * -> *) a. Monad m => a -> m a
return FTycon
boolFTyCon)
  Parser FTycon -> Parser FTycon -> Parser FTycon
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (LocSymbol -> FTycon
symbolFTycon      (LocSymbol -> FTycon)
-> ParsecT String Integer (State PState) LocSymbol -> Parser FTycon
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String Integer (State PState) LocSymbol
locUpperIdP)
  Parser FTycon -> String -> Parser FTycon
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"fTyConP"