{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

module Lang.Crucible.Syntax.Concrete
  ( -- * Errors
    ExprErr(..)
  -- * Parsing and Results
  , ParserHooks(..)
  , ParsedProgram(..)
  , defaultParserHooks
  , top
  , cfgs
  , prog
  -- * Low level parsing operations
  , SyntaxState(..)
  , atomName
  , freshAtom
  , nat
  , string
  , isType
  , operands
  , BoundedNat(..)
  , PosNat
  , posNat
  , someAssign
  -- * Rules for pretty-printing language syntax
  , printExpr
  )
where

import Prelude hiding (fail)

import Control.Lens hiding (cons, backwards)
import Control.Applicative
import Control.Monad (MonadPlus(..), forM, join)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Identity ()
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (MonadReader, ReaderT(..))
import Control.Monad.State.Strict (MonadState(..), StateT(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Except (ExceptT(..))
import Control.Monad.Writer.Strict (MonadWriter(..), WriterT(..))

import Lang.Crucible.Types

import qualified Data.BitVector.Sized as BV
import Data.Foldable
import Data.Functor
import qualified Data.Functor.Product as Functor
import Data.Kind (Type)
import Data.Maybe
import Data.Parameterized.Some(Some(..))
import Data.Parameterized.Pair (Pair(..))
import Data.Parameterized.TraversableFC
import Data.Parameterized.Classes
import Data.Parameterized.Nonce ( NonceGenerator, Nonce
                                , freshNonce )
import qualified Data.Parameterized.Context as Ctx
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import Numeric.Natural
import qualified Prettyprinter as PP

import Lang.Crucible.Syntax.ExprParse hiding (SyntaxError)
import qualified Lang.Crucible.Syntax.ExprParse as SP
import Lang.Crucible.Syntax.Monad

import What4.ProgramLoc
import What4.FunctionName
import What4.Symbol
import What4.Utils.StringLiteral

import Lang.Crucible.Syntax.SExpr (Syntax, pattern L, pattern A, toText, PrintRules(..), PrintStyle(..), syntaxPos, withPosFrom, showAtom)
import Lang.Crucible.Syntax.Atoms hiding (atom)

import Lang.Crucible.CFG.Reg hiding (globalName)
import Lang.Crucible.CFG.Expr

import Lang.Crucible.FunctionHandle

import Numeric.Natural ()
import qualified Data.Set as Set

liftSyntaxParse :: (MonadError (ExprErr s) m, MonadIO m)
                  => SyntaxParse Atomic a -> AST s -> m a
liftSyntaxParse :: forall {k} (s :: k) (m :: * -> *) a.
(MonadError (ExprErr s) m, MonadIO m) =>
SyntaxParse Atomic a -> AST s -> m a
liftSyntaxParse SyntaxParse Atomic a
p AST s
ast =
  IO (Either (SyntaxError Atomic) a)
-> m (Either (SyntaxError Atomic) a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SyntaxParse Atomic a -> AST s -> IO (Either (SyntaxError Atomic) a)
forall atom a.
IsAtom atom =>
SyntaxParse atom a
-> Syntax atom -> IO (Either (SyntaxError atom) a)
syntaxParseIO SyntaxParse Atomic a
p AST s
ast) m (Either (SyntaxError Atomic) a)
-> (Either (SyntaxError Atomic) a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left SyntaxError Atomic
e -> ExprErr s -> m a
forall a. ExprErr s -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SyntaxError Atomic -> ExprErr s
forall {k} (s :: k). SyntaxError Atomic -> ExprErr s
SyntaxParseError SyntaxError Atomic
e)
    Right a
v -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v

type AST s = Syntax Atomic



printExpr :: AST s -> Text
printExpr :: forall {k} (s :: k). AST s -> Text
printExpr = PrintRules Atomic -> AST s -> Text
forall expr a.
(Syntactic expr a, IsAtom a) =>
PrintRules a -> expr -> Text
toText ((Atomic -> Maybe PrintStyle) -> PrintRules Atomic
forall a. (a -> Maybe PrintStyle) -> PrintRules a
PrintRules Atomic -> Maybe PrintStyle
rules)
  where rules :: Atomic -> Maybe PrintStyle
rules (Kw Keyword
Defun) = PrintStyle -> Maybe PrintStyle
forall a. a -> Maybe a
Just (Int -> PrintStyle
Special Int
3)
        rules (Kw Keyword
DefBlock) = PrintStyle -> Maybe PrintStyle
forall a. a -> Maybe a
Just (Int -> PrintStyle
Special Int
1)
        rules (Kw Keyword
Start) = PrintStyle -> Maybe PrintStyle
forall a. a -> Maybe a
Just (Int -> PrintStyle
Special Int
1)
        rules (Kw Keyword
Registers) = PrintStyle -> Maybe PrintStyle
forall a. a -> Maybe a
Just (Int -> PrintStyle
Special Int
0)
        rules Atomic
_ = Maybe PrintStyle
forall a. Maybe a
Nothing

data E ext s t where
  EAtom  :: !(Atom s t) -> E ext s t
  EReg   :: !Position -> !(Reg s t) -> E ext s t
  EGlob  :: !Position -> !(GlobalVar t) -> E ext s t
  EDeref :: !Position -> !(E ext s (ReferenceType t)) -> E ext s t
  EApp   :: !(App ext (E ext s) t) -> E ext s t

data SomeExpr ext s where
  SomeE :: TypeRepr t -> E ext s t -> SomeExpr ext s
  SomeOverloaded :: AST s -> Keyword -> [SomeExpr ext s] -> SomeExpr ext s
  SomeIntLiteral :: AST s -> Integer -> SomeExpr ext s

data SomeBVExpr ext s where
  SomeBVExpr :: (1 <= w) => NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s

data ExprErr s where
  TrivialErr :: Position -> ExprErr s
  Errs :: ExprErr s -> ExprErr s -> ExprErr s
  DuplicateAtom :: Position -> AtomName -> ExprErr s
  DuplicateLabel :: Position -> LabelName -> ExprErr s
  EmptyBlock :: Position -> ExprErr s
  NotGlobal :: Position -> AST s -> ExprErr s
  InvalidRegister :: Position -> AST s -> ExprErr s
  SyntaxParseError :: SP.SyntaxError Atomic -> ExprErr s

deriving instance Show (ExprErr s)

instance Semigroup (ExprErr s) where
  <> :: ExprErr s -> ExprErr s -> ExprErr s
(<>) = ExprErr s -> ExprErr s -> ExprErr s
forall k (s :: k). ExprErr s -> ExprErr s -> ExprErr s
Errs

instance Monoid (ExprErr s) where
  mempty :: ExprErr s
mempty = Position -> ExprErr s
forall {k} (s :: k). Position -> ExprErr s
TrivialErr (Text -> Position
OtherPos Text
"mempty")

instance PP.Pretty (ExprErr s) where
  pretty :: forall ann. ExprErr s -> Doc ann
pretty =
    \case
      TrivialErr Position
p ->
        Doc ann
"Trivial error at" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> Position -> Doc ann
forall a ann. Show a => a -> Doc ann
PP.viaShow Position
p
      Errs ExprErr s
e1 ExprErr s
e2 ->
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
PP.vcat [Doc ann
"Multiple errors:" , ExprErr s -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExprErr s -> Doc ann
PP.pretty ExprErr s
e1 , ExprErr s -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExprErr s -> Doc ann
PP.pretty ExprErr s
e2]
      DuplicateAtom Position
p AtomName
a ->
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
PP.hsep [Doc ann
"Duplicate atom", Doc ann -> Doc ann
forall {ann}. Doc ann -> Doc ann
backticks (AtomName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AtomName -> Doc ann
PP.pretty AtomName
a), Doc ann
"at", Position -> Doc ann
forall a ann. Show a => a -> Doc ann
PP.viaShow Position
p]
      DuplicateLabel Position
p LabelName
l ->
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
PP.hsep [Doc ann
"Duplicate label", Doc ann -> Doc ann
forall {ann}. Doc ann -> Doc ann
backticks (LabelName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. LabelName -> Doc ann
PP.pretty LabelName
l), Doc ann
"at", Position -> Doc ann
forall a ann. Show a => a -> Doc ann
PP.viaShow Position
p]
      EmptyBlock Position
p ->
        Doc ann
"Empty block at" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> Position -> Doc ann
forall a ann. Show a => a -> Doc ann
PP.viaShow Position
p
      NotGlobal Position
p AST s
_ast ->
        Doc ann
"Expected a global at" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> Position -> Doc ann
forall a ann. Show a => a -> Doc ann
PP.viaShow Position
p
      InvalidRegister Position
p AST s
_ast ->
        Doc ann
"Expected a register at" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> Position -> Doc ann
forall a ann. Show a => a -> Doc ann
PP.viaShow Position
p
      SyntaxParseError SyntaxError Atomic
err ->
        Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty (SyntaxError Atomic -> Text
forall atom. IsAtom atom => SyntaxError atom -> Text
printSyntaxError SyntaxError Atomic
err)
    where backticks :: Doc ann -> Doc ann
backticks = Doc ann -> Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann
PP.enclose Doc ann
"`" Doc ann
"`"

-- | ParserHooks enables support for arbitrary syntax extensions by allowing
-- users to supply their own parsers for types and syntax extensions.
data ParserHooks ext = ParserHooks {
    -- | extensionTypeParser is called for all type specifications and enables
    -- the addition of new types to crucible-syntax.
    forall ext.
ParserHooks ext
-> forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
extensionTypeParser :: forall m. MonadSyntax Atomic m => m (Some TypeRepr)

    -- | extensionParser is called when parsing statements and let bindings
    -- (everywhere function calls are supported) and enables the addition of
    -- syntax extensions to crucible-syntax.
  , forall ext.
ParserHooks ext
-> forall s (m :: * -> *).
   (MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
    MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
    ?parserHooks::ParserHooks ext) =>
   m (Some (Atom s))
extensionParser
    :: forall s m
     . ( MonadSyntax Atomic m
       , MonadWriter [Posd (Stmt ext s)] m
       , MonadState (SyntaxState s) m
       , MonadIO m
       , IsSyntaxExtension ext
       , ?parserHooks :: ParserHooks ext
       -- ParserHooks instance to use recursively when parsing.
       )
    => m (Some (Atom s))
    -- ^ The atom computed from evaluating the syntax extension.
}

-- | A ParserHooks instance that adds no extensions to the crucible-syntax
-- language.
defaultParserHooks :: ParserHooks ()
defaultParserHooks :: ParserHooks ()
defaultParserHooks = (forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr))
-> (forall s (m :: * -> *).
    (MonadSyntax Atomic m, MonadWriter [Posd (Stmt () s)] m,
     MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension (),
     ?parserHooks::ParserHooks ()) =>
    m (Some (Atom s)))
-> ParserHooks ()
forall ext.
(forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr))
-> (forall s (m :: * -> *).
    (MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
     MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
     ?parserHooks::ParserHooks ext) =>
    m (Some (Atom s)))
-> ParserHooks ext
ParserHooks m (Some TypeRepr)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
empty m (Some (Atom s))
forall a. m a
forall s (m :: * -> *).
(MonadSyntax Atomic m, MonadWriter [Posd (Stmt () s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension (),
 ?parserHooks::ParserHooks ()) =>
m (Some (Atom s))
forall (f :: * -> *) a. Alternative f => f a
empty

-- | The results of parsing a program.
data ParsedProgram ext = ParsedProgram
  { forall ext. ParsedProgram ext -> Map GlobalName (Some GlobalVar)
parsedProgGlobals :: Map GlobalName (Some GlobalVar)
    -- ^ The parsed @defglobal@s.
  , forall ext. ParsedProgram ext -> Map GlobalName (Some GlobalVar)
parsedProgExterns :: Map GlobalName (Some GlobalVar)
    -- ^ For each parsed @extern@, map its name to its global variable. It is
    --   the responsibility of the caller to insert each global variable into
    --   the 'SymGlobalState' alongside an appropriate 'RegValue'.
  , forall ext. ParsedProgram ext -> [AnyCFG ext]
parsedProgCFGs :: [AnyCFG ext]
    -- ^ The CFGs for each parsed @defun@.
  , forall ext. ParsedProgram ext -> Map FunctionName SomeHandle
parsedProgForwardDecs :: Map FunctionName SomeHandle
    -- ^ For each parsed @declare@, map its name to its function handle. It is
    --   the responsibility of the caller to register each handle with an
    --   appropriate 'FnState'.
  }


kw :: MonadSyntax Atomic m => Keyword -> m ()
kw :: forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
k = Text -> m () -> m ()
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"the keyword " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Atomic -> Text
forall a. IsAtom a => a -> Text
showAtom (Keyword -> Atomic
Kw Keyword
k)) (Atomic -> m ()
forall atom (m :: * -> *).
(MonadSyntax atom m, IsAtom atom, Eq atom) =>
atom -> m ()
atom (Keyword -> Atomic
Kw Keyword
k))

int :: MonadSyntax Atomic m => m Integer
int :: forall (m :: * -> *). MonadSyntax Atomic m => m Integer
int = Text -> (Atomic -> Maybe Integer) -> m Atomic -> m Integer
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"integer literal" Atomic -> Maybe Integer
numeric m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where numeric :: Atomic -> Maybe Integer
numeric (Int Integer
i) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i
        numeric Atomic
_ = Maybe Integer
forall a. Maybe a
Nothing

nat :: MonadSyntax Atomic m => m Natural
nat :: forall (m :: * -> *). MonadSyntax Atomic m => m Natural
nat = Text -> (Atomic -> Maybe Natural) -> m Atomic -> m Natural
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"natural literal" Atomic -> Maybe Natural
forall {a}. Num a => Atomic -> Maybe a
isNat m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where isNat :: Atomic -> Maybe a
isNat (Int Integer
i) | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = a -> Maybe a
forall a. a -> Maybe a
Just (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
i)
        isNat Atomic
_ = Maybe a
forall a. Maybe a
Nothing

labelName :: MonadSyntax Atomic m => m LabelName
labelName :: forall (m :: * -> *). MonadSyntax Atomic m => m LabelName
labelName = Text -> (Atomic -> Maybe LabelName) -> m Atomic -> m LabelName
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"label name" Atomic -> Maybe LabelName
lbl m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where lbl :: Atomic -> Maybe LabelName
lbl (Lbl LabelName
l) = LabelName -> Maybe LabelName
forall a. a -> Maybe a
Just LabelName
l
        lbl Atomic
_ = Maybe LabelName
forall a. Maybe a
Nothing

regName :: MonadSyntax Atomic m => m RegName
regName :: forall (m :: * -> *). MonadSyntax Atomic m => m RegName
regName = Text -> (Atomic -> Maybe RegName) -> m Atomic -> m RegName
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"register name" Atomic -> Maybe RegName
reg m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where reg :: Atomic -> Maybe RegName
reg (Rg RegName
rn) = RegName -> Maybe RegName
forall a. a -> Maybe a
Just RegName
rn
        reg Atomic
_ = Maybe RegName
forall a. Maybe a
Nothing

globalName :: MonadSyntax Atomic m => m GlobalName
globalName :: forall (m :: * -> *). MonadSyntax Atomic m => m GlobalName
globalName = Text -> (Atomic -> Maybe GlobalName) -> m Atomic -> m GlobalName
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"name of global variable" Atomic -> Maybe GlobalName
glob m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where glob :: Atomic -> Maybe GlobalName
glob (Gl GlobalName
x) = GlobalName -> Maybe GlobalName
forall a. a -> Maybe a
Just GlobalName
x
        glob Atomic
_ = Maybe GlobalName
forall a. Maybe a
Nothing


rational :: MonadSyntax Atomic m => m Rational
rational :: forall (m :: * -> *). MonadSyntax Atomic m => m Rational
rational = Text -> (Atomic -> Maybe Rational) -> m Atomic -> m Rational
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"rational number literal" Atomic -> Maybe Rational
numeric m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where numeric :: Atomic -> Maybe Rational
numeric (Rat Rational
r) = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
r
        numeric Atomic
_ = Maybe Rational
forall a. Maybe a
Nothing


string :: MonadSyntax Atomic m => m Text
string :: forall (m :: * -> *). MonadSyntax Atomic m => m Text
string = Text -> (Atomic -> Maybe Text) -> m Atomic -> m Text
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"string literal" Atomic -> Maybe Text
stringy m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where stringy :: Atomic -> Maybe Text
stringy (StrLit Text
t) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
        stringy Atomic
_ = Maybe Text
forall a. Maybe a
Nothing

atomName :: MonadSyntax Atomic m => m AtomName
atomName :: forall (m :: * -> *). MonadSyntax Atomic m => m AtomName
atomName = Text -> (Atomic -> Maybe AtomName) -> m Atomic -> m AtomName
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"Crucible atom literal" Atomic -> Maybe AtomName
isCAtom m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where isCAtom :: Atomic -> Maybe AtomName
isCAtom (At AtomName
a) = AtomName -> Maybe AtomName
forall a. a -> Maybe a
Just AtomName
a
        isCAtom Atomic
_ = Maybe AtomName
forall a. Maybe a
Nothing

roundingMode :: MonadSyntax Atomic m => m RoundingMode
roundingMode :: forall (m :: * -> *). MonadSyntax Atomic m => m RoundingMode
roundingMode = Text -> m RoundingMode -> m RoundingMode
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"rounding mode" (m RoundingMode -> m RoundingMode)
-> m RoundingMode -> m RoundingMode
forall a b. (a -> b) -> a -> b
$
        [m RoundingMode] -> m RoundingMode
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
RNE_ m () -> RoundingMode -> m RoundingMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RoundingMode
RNE
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
RNA_ m () -> RoundingMode -> m RoundingMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RoundingMode
RNA
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
RTP_ m () -> RoundingMode -> m RoundingMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RoundingMode
RTP
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
RTN_ m () -> RoundingMode -> m RoundingMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RoundingMode
RTN
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
RTZ_ m () -> RoundingMode -> m RoundingMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RoundingMode
RTZ
             ]

fpinfo :: MonadSyntax Atomic m => m (Some FloatInfoRepr)
fpinfo :: forall (m :: * -> *).
MonadSyntax Atomic m =>
m (Some FloatInfoRepr)
fpinfo = [m (Some FloatInfoRepr)] -> m (Some FloatInfoRepr)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Half_         m () -> Some FloatInfoRepr -> m (Some FloatInfoRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatInfoRepr 'HalfFloat -> Some FloatInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some FloatInfoRepr 'HalfFloat
HalfFloatRepr
              , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Float_        m () -> Some FloatInfoRepr -> m (Some FloatInfoRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatInfoRepr 'SingleFloat -> Some FloatInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some FloatInfoRepr 'SingleFloat
SingleFloatRepr
              , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Double_       m () -> Some FloatInfoRepr -> m (Some FloatInfoRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatInfoRepr 'DoubleFloat -> Some FloatInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some FloatInfoRepr 'DoubleFloat
DoubleFloatRepr
              , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Quad_         m () -> Some FloatInfoRepr -> m (Some FloatInfoRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatInfoRepr 'QuadFloat -> Some FloatInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some FloatInfoRepr 'QuadFloat
QuadFloatRepr
              , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
X86_80_       m () -> Some FloatInfoRepr -> m (Some FloatInfoRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatInfoRepr 'X86_80Float -> Some FloatInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some FloatInfoRepr 'X86_80Float
X86_80FloatRepr
              , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
DoubleDouble_ m () -> Some FloatInfoRepr -> m (Some FloatInfoRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FloatInfoRepr 'DoubleDoubleFloat -> Some FloatInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some FloatInfoRepr 'DoubleDoubleFloat
DoubleDoubleFloatRepr
              ]

bool :: MonadSyntax Atomic m => m  Bool
bool :: forall (m :: * -> *). MonadSyntax Atomic m => m Bool
bool = Text -> (Atomic -> Maybe Bool) -> m Atomic -> m Bool
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"Boolean literal" Atomic -> Maybe Bool
isBool m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where isBool :: Atomic -> Maybe Bool
isBool (Bool Bool
b) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
        isBool Atomic
_ = Maybe Bool
forall a. Maybe a
Nothing

funName :: MonadSyntax Atomic m => m  FunctionName
funName :: forall (m :: * -> *). MonadSyntax Atomic m => m FunctionName
funName = Text -> FunctionName
functionNameFromText (Text -> FunctionName) -> m Text -> m FunctionName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> (Atomic -> Maybe Text) -> m Atomic -> m Text
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"function name literal" Atomic -> Maybe Text
isFn m Atomic
forall atom (m :: * -> *). MonadSyntax atom m => m atom
atomic
  where isFn :: Atomic -> Maybe Text
isFn (Fn (FunName Text
n)) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n
        isFn Atomic
_ = Maybe Text
forall a. Maybe a
Nothing

toCtx :: forall f . [Some f] -> Some (Ctx.Assignment f)
toCtx :: forall {k} (f :: k -> *). [Some f] -> Some (Assignment f)
toCtx [Some f]
fs = [Some f] -> Some (Assignment f)
toCtx' ([Some f] -> [Some f]
forall a. [a] -> [a]
reverse [Some f]
fs)
  where toCtx' :: [Some f] -> Some (Ctx.Assignment f)
        toCtx' :: [Some f] -> Some (Assignment f)
toCtx' [] = Assignment f EmptyCtx -> Some (Assignment f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Assignment f EmptyCtx
forall {k} (f :: k -> *). Assignment f EmptyCtx
Ctx.empty
        toCtx' (Some f x
x : ([Some f] -> Some (Assignment f)
toCtx' -> Some Assignment f x
xs)) =
          Assignment f (x ::> x) -> Some (Assignment f)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Assignment f (x ::> x) -> Some (Assignment f))
-> Assignment f (x ::> x) -> Some (Assignment f)
forall a b. (a -> b) -> a -> b
$ Assignment f x -> f x -> Assignment f (x ::> x)
forall {k} (f :: k -> *) (ctx :: Ctx k) (x :: k).
Assignment f ctx -> f x -> Assignment f (ctx ::> x)
Ctx.extend Assignment f x
xs f x
x

unary :: MonadSyntax Atomic m => Keyword -> m a -> m a
unary :: forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
k m a
p = m () -> m (a, ()) -> m (a, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
k) (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
commit m () -> m (a, ()) -> m (a, ())
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a -> m () -> m (a, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m a
p m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList) m (a, ()) -> ((a, ()) -> a) -> m a
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (a, ()) -> a
forall a b. (a, b) -> a
fst

binary :: MonadSyntax Atomic m => Keyword -> m a -> m b -> m (a, b)
binary :: forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
k m a
p1 m b
p2 = m () -> m (a, (b, ())) -> m (a, (b, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
k) (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
commit m () -> m (a, (b, ())) -> m (a, (b, ()))
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a -> m (b, ()) -> m (a, (b, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m a
p1 (m b -> m () -> m (b, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m b
p2 m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList)) m (a, (b, ())) -> ((a, (b, ())) -> (a, b)) -> m (a, b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(a
x, (b
y, ())) -> (a
x, b
y)


mkFunRepr :: [Some TypeRepr] -> Some TypeRepr -> Some TypeRepr
mkFunRepr :: [Some TypeRepr] -> Some TypeRepr -> Some TypeRepr
mkFunRepr ([Some TypeRepr] -> Some (Assignment TypeRepr)
forall {k} (f :: k -> *). [Some f] -> Some (Assignment f)
toCtx -> Some Assignment TypeRepr x
doms) (Some TypeRepr x
ran) = TypeRepr ('FunctionHandleType x x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr ('FunctionHandleType x x) -> Some TypeRepr)
-> TypeRepr ('FunctionHandleType x x) -> Some TypeRepr
forall a b. (a -> b) -> a -> b
$ Assignment TypeRepr x
-> TypeRepr x -> TypeRepr ('FunctionHandleType x x)
forall (ctx :: Ctx CrucibleType) (ret :: CrucibleType).
CtxRepr ctx
-> TypeRepr ret -> TypeRepr ('FunctionHandleType ctx ret)
FunctionHandleRepr Assignment TypeRepr x
doms TypeRepr x
ran

repUntilLast :: MonadSyntax Atomic m => m a -> m ([a], a)
repUntilLast :: forall (m :: * -> *) a. MonadSyntax Atomic m => m a -> m ([a], a)
repUntilLast m a
sp = Text -> m ([a], a) -> m ([a], a)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"zero or more followed by one" (m ([a], a) -> m ([a], a)) -> m ([a], a) -> m ([a], a)
forall a b. (a -> b) -> a -> b
$ m a -> m ([a], a)
forall {f :: * -> *} {atom} {a}.
MonadSyntax atom f =>
f a -> f ([a], a)
repUntilLast' m a
sp
  where repUntilLast' :: f a -> f ([a], a)
repUntilLast' f a
p =
          (f a -> f () -> f (a, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons f a
p f ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList f (a, ()) -> ((a, ()) -> ([a], a)) -> f ([a], a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(a
x, ()) -> ([], a
x)) f ([a], a) -> f ([a], a) -> f ([a], a)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          (f a -> f ([a], a) -> f (a, ([a], a))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons f a
p (f a -> f ([a], a)
repUntilLast' f a
p) f (a, ([a], a)) -> ((a, ([a], a)) -> ([a], a)) -> f ([a], a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(a
x, ([a]
xs, a
lst)) -> (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, a
lst))

_isBaseType :: ( ?parserHooks :: ParserHooks ext, MonadSyntax Atomic m )
            => m (Some BaseTypeRepr)
_isBaseType :: forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some BaseTypeRepr)
_isBaseType =
  Text -> m (Some BaseTypeRepr) -> m (Some BaseTypeRepr)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"base type" (m (Some BaseTypeRepr) -> m (Some BaseTypeRepr))
-> m (Some BaseTypeRepr) -> m (Some BaseTypeRepr)
forall a b. (a -> b) -> a -> b
$
  do Some TypeRepr x
tp <- m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType
     case TypeRepr x -> AsBaseType x
forall (tp :: CrucibleType). TypeRepr tp -> AsBaseType tp
asBaseType TypeRepr x
tp of
       AsBaseType x
NotBaseType -> m (Some BaseTypeRepr)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
       AsBaseType BaseTypeRepr bt
bt -> Some BaseTypeRepr -> m (Some BaseTypeRepr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BaseTypeRepr bt -> Some BaseTypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some BaseTypeRepr bt
bt)

_isFloatingType :: ( ?parserHooks :: ParserHooks ext, MonadSyntax Atomic m )
                => m (Some FloatInfoRepr)
_isFloatingType :: forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some FloatInfoRepr)
_isFloatingType =
  Text -> m (Some FloatInfoRepr) -> m (Some FloatInfoRepr)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"floating-point type" (m (Some FloatInfoRepr) -> m (Some FloatInfoRepr))
-> m (Some FloatInfoRepr) -> m (Some FloatInfoRepr)
forall a b. (a -> b) -> a -> b
$
  do Some TypeRepr x
tp <- m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType
     case TypeRepr x
tp of
       FloatRepr FloatInfoRepr flt
fi -> Some FloatInfoRepr -> m (Some FloatInfoRepr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FloatInfoRepr flt -> Some FloatInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some FloatInfoRepr flt
fi)
       TypeRepr x
_ -> m (Some FloatInfoRepr)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

data BoundedNat bnd =
  forall w. (bnd <= w) => BoundedNat (NatRepr w)

type PosNat = BoundedNat 1

posNat :: MonadSyntax Atomic m => m PosNat
posNat :: forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat =
   do Natural
i <- Text -> (Natural -> Maybe Natural) -> m Natural -> m Natural
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"positive nat literal" Natural -> Maybe Natural
forall {a}. (Ord a, Num a) => a -> Maybe a
checkPosNat m Natural
forall (m :: * -> *). MonadSyntax Atomic m => m Natural
nat
      m PosNat -> (PosNat -> m PosNat) -> Maybe PosNat -> m PosNat
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m PosNat
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty PosNat -> m PosNat
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PosNat -> m PosNat) -> Maybe PosNat -> m PosNat
forall a b. (a -> b) -> a -> b
$ do Some NatRepr x
x <- Some NatRepr -> Maybe (Some NatRepr)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Some NatRepr -> Maybe (Some NatRepr))
-> Some NatRepr -> Maybe (Some NatRepr)
forall a b. (a -> b) -> a -> b
$ Natural -> Some NatRepr
mkNatRepr Natural
i
                              LeqProof 1 x
LeqProof <- NatRepr x -> Maybe (LeqProof 1 x)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr x
x
                              PosNat -> Maybe PosNat
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PosNat -> Maybe PosNat) -> PosNat -> Maybe PosNat
forall a b. (a -> b) -> a -> b
$ NatRepr x -> PosNat
forall (bnd :: Natural) (w :: Natural).
(bnd <= w) =>
NatRepr w -> BoundedNat bnd
BoundedNat NatRepr x
x
  where checkPosNat :: a -> Maybe a
checkPosNat a
i | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 = a -> Maybe a
forall a. a -> Maybe a
Just a
i
        checkPosNat a
_ = Maybe a
forall a. Maybe a
Nothing

natRepr :: MonadSyntax Atomic m => m (Some NatRepr)
natRepr :: forall (m :: * -> *). MonadSyntax Atomic m => m (Some NatRepr)
natRepr = Natural -> Some NatRepr
mkNatRepr (Natural -> Some NatRepr) -> m Natural -> m (Some NatRepr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Natural
forall (m :: * -> *). MonadSyntax Atomic m => m Natural
nat

stringSort :: MonadSyntax Atomic m => m (Some StringInfoRepr)
stringSort :: forall (m :: * -> *).
MonadSyntax Atomic m =>
m (Some StringInfoRepr)
stringSort =
  m (Some StringInfoRepr) -> m (Some StringInfoRepr)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (Some StringInfoRepr) -> m (Some StringInfoRepr))
-> m (Some StringInfoRepr) -> m (Some StringInfoRepr)
forall a b. (a -> b) -> a -> b
$ Text -> m (Some StringInfoRepr) -> m (Some StringInfoRepr)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"string sort" (m (Some StringInfoRepr) -> m (Some StringInfoRepr))
-> m (Some StringInfoRepr) -> m (Some StringInfoRepr)
forall a b. (a -> b) -> a -> b
$
    [m (Some StringInfoRepr)] -> m (Some StringInfoRepr)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Unicode_ m () -> Some StringInfoRepr -> m (Some StringInfoRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StringInfoRepr 'Unicode -> Some StringInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some StringInfoRepr 'Unicode
UnicodeRepr
         , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Char16_  m () -> Some StringInfoRepr -> m (Some StringInfoRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StringInfoRepr 'Char16 -> Some StringInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some StringInfoRepr 'Char16
Char16Repr
         , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Char8_   m () -> Some StringInfoRepr -> m (Some StringInfoRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StringInfoRepr 'Char8 -> Some StringInfoRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some StringInfoRepr 'Char8
Char8Repr
         ]

isType :: ( ?parserHooks :: ParserHooks ext, MonadSyntax Atomic m )
       => m (Some TypeRepr)
isType :: forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType =
  Text -> m (Some TypeRepr) -> m (Some TypeRepr)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"type" (m (Some TypeRepr) -> m (Some TypeRepr))
-> m (Some TypeRepr) -> m (Some TypeRepr)
forall a b. (a -> b) -> a -> b
$ m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call
    (m (Some TypeRepr)
atomicType m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
stringT m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
vector m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
seqt m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
ref m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
bv m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
fp m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
fun m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
maybeT m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
var m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some TypeRepr)
forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
struct m (Some TypeRepr) -> m (Some TypeRepr) -> m (Some TypeRepr)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParserHooks ext
-> forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
forall ext.
ParserHooks ext
-> forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
extensionTypeParser ?parserHooks::ParserHooks ext
ParserHooks ext
?parserHooks))

  where
    atomicType :: m (Some TypeRepr)
atomicType =
      m (Some TypeRepr) -> m (Some TypeRepr)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (Some TypeRepr) -> m (Some TypeRepr))
-> m (Some TypeRepr) -> m (Some TypeRepr)
forall a b. (a -> b) -> a -> b
$ Text -> m (Some TypeRepr) -> m (Some TypeRepr)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"atomic type" (m (Some TypeRepr) -> m (Some TypeRepr))
-> m (Some TypeRepr) -> m (Some TypeRepr)
forall a b. (a -> b) -> a -> b
$
        [m (Some TypeRepr)] -> m (Some TypeRepr)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [ Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
AnyT         m () -> Some TypeRepr -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeRepr 'AnyType -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr 'AnyType
AnyRepr
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
UnitT        m () -> Some TypeRepr -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeRepr 'UnitType -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr 'UnitType
UnitRepr
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
BoolT        m () -> Some TypeRepr -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeRepr ('BaseToType BaseBoolType) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr ('BaseToType BaseBoolType)
BoolRepr
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
NatT         m () -> Some TypeRepr -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeRepr 'NatType -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr 'NatType
NatRepr
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
IntegerT     m () -> Some TypeRepr -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeRepr ('BaseToType BaseIntegerType) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr ('BaseToType BaseIntegerType)
IntegerRepr
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
RealT        m () -> Some TypeRepr -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeRepr ('BaseToType BaseRealType) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr ('BaseToType BaseRealType)
RealValRepr
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
ComplexRealT m () -> Some TypeRepr -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeRepr ('BaseToType BaseComplexType) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr ('BaseToType BaseComplexType)
ComplexRealRepr
             , Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
CharT        m () -> Some TypeRepr -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeRepr 'CharType -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr 'CharType
CharRepr
             ]
    vector :: m (Some TypeRepr)
vector = Keyword -> m (Some TypeRepr) -> m (Some TypeRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
VectorT m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType m (Some TypeRepr)
-> (Some TypeRepr -> Some TypeRepr) -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Some TypeRepr x
t) -> TypeRepr ('VectorType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr x -> TypeRepr ('VectorType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr x
t)
    seqt :: m (Some TypeRepr)
seqt   = Keyword -> m (Some TypeRepr) -> m (Some TypeRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
SequenceT m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType m (Some TypeRepr)
-> (Some TypeRepr -> Some TypeRepr) -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Some TypeRepr x
t) -> TypeRepr ('SequenceType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr x -> TypeRepr ('SequenceType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr x
t)
    ref :: m (Some TypeRepr)
ref    = Keyword -> m (Some TypeRepr) -> m (Some TypeRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
RefT m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType m (Some TypeRepr)
-> (Some TypeRepr -> Some TypeRepr) -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Some TypeRepr x
t) -> TypeRepr ('ReferenceType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr x -> TypeRepr ('ReferenceType x)
forall (a :: CrucibleType).
TypeRepr a -> TypeRepr ('ReferenceType a)
ReferenceRepr TypeRepr x
t)
    bv :: MonadSyntax Atomic m => m  (Some TypeRepr)
    bv :: forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
bv     = do BoundedNat NatRepr w
len <- Keyword -> m PosNat -> m PosNat
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
BitvectorT m PosNat
forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat
                Some TypeRepr -> m (Some TypeRepr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Some TypeRepr -> m (Some TypeRepr))
-> Some TypeRepr -> m (Some TypeRepr)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseBVType w)) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr ('BaseToType (BaseBVType w)) -> Some TypeRepr)
-> TypeRepr ('BaseToType (BaseBVType w)) -> Some TypeRepr
forall a b. (a -> b) -> a -> b
$ NatRepr w -> TypeRepr ('BaseToType (BaseBVType w))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr w
len

    fp :: MonadSyntax Atomic m => m (Some TypeRepr)
    fp :: forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
fp = do Some FloatInfoRepr x
fpi <- Keyword -> m (Some FloatInfoRepr) -> m (Some FloatInfoRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
FPT m (Some FloatInfoRepr)
forall (m :: * -> *).
MonadSyntax Atomic m =>
m (Some FloatInfoRepr)
fpinfo
            Some TypeRepr -> m (Some TypeRepr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Some TypeRepr -> m (Some TypeRepr))
-> Some TypeRepr -> m (Some TypeRepr)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('FloatType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr ('FloatType x) -> Some TypeRepr)
-> TypeRepr ('FloatType x) -> Some TypeRepr
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr x -> TypeRepr ('FloatType x)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr x
fpi

    fun :: MonadSyntax Atomic m => m (Some TypeRepr)
    fun :: forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
fun = m ()
-> m ([Some TypeRepr], Some TypeRepr)
-> m ((), ([Some TypeRepr], Some TypeRepr))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
FunT) (m (Some TypeRepr) -> m ([Some TypeRepr], Some TypeRepr)
forall (m :: * -> *) a. MonadSyntax Atomic m => m a -> m ([a], a)
repUntilLast m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType) m ((), ([Some TypeRepr], Some TypeRepr))
-> (((), ([Some TypeRepr], Some TypeRepr)) -> Some TypeRepr)
-> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \((), ([Some TypeRepr]
args, Some TypeRepr
ret)) -> [Some TypeRepr] -> Some TypeRepr -> Some TypeRepr
mkFunRepr [Some TypeRepr]
args Some TypeRepr
ret

    stringT :: MonadSyntax Atomic m => m (Some TypeRepr)
    stringT :: forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
stringT = Keyword -> m (Some StringInfoRepr) -> m (Some StringInfoRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
StringT m (Some StringInfoRepr)
forall (m :: * -> *).
MonadSyntax Atomic m =>
m (Some StringInfoRepr)
stringSort m (Some StringInfoRepr)
-> (Some StringInfoRepr -> Some TypeRepr) -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Some StringInfoRepr x
si) -> TypeRepr ('BaseToType (BaseStringType x)) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (StringInfoRepr x -> TypeRepr ('BaseToType (BaseStringType x))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr x
si)

    maybeT :: m (Some TypeRepr)
maybeT = Keyword -> m (Some TypeRepr) -> m (Some TypeRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
MaybeT m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType m (Some TypeRepr)
-> (Some TypeRepr -> Some TypeRepr) -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Some TypeRepr x
t) -> TypeRepr ('MaybeType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr x -> TypeRepr ('MaybeType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr TypeRepr x
t)

    var :: MonadSyntax Atomic m => m (Some TypeRepr)
    var :: forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
var = m () -> m [Some TypeRepr] -> m ((), [Some TypeRepr])
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
VariantT) (m (Some TypeRepr) -> m [Some TypeRepr]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m [a]
rep m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType) m ((), [Some TypeRepr])
-> (((), [Some TypeRepr]) -> Some TypeRepr) -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \((), [Some TypeRepr] -> Some (Assignment TypeRepr)
forall {k} (f :: k -> *). [Some f] -> Some (Assignment f)
toCtx -> Some Assignment TypeRepr x
tys) -> TypeRepr ('VariantType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Assignment TypeRepr x -> TypeRepr ('VariantType x)
forall (ctx :: Ctx CrucibleType).
CtxRepr ctx -> TypeRepr ('VariantType ctx)
VariantRepr Assignment TypeRepr x
tys)

    struct ::  MonadSyntax Atomic m => m (Some TypeRepr)
    struct :: forall (m :: * -> *). MonadSyntax Atomic m => m (Some TypeRepr)
struct = m () -> m [Some TypeRepr] -> m ((), [Some TypeRepr])
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
StructT) (m (Some TypeRepr) -> m [Some TypeRepr]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m [a]
rep m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType) m ((), [Some TypeRepr])
-> (((), [Some TypeRepr]) -> Some TypeRepr) -> m (Some TypeRepr)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \((), [Some TypeRepr] -> Some (Assignment TypeRepr)
forall {k} (f :: k -> *). [Some f] -> Some (Assignment f)
toCtx -> Some Assignment TypeRepr x
tys) -> TypeRepr ('StructType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Assignment TypeRepr x -> TypeRepr ('StructType x)
forall (ctx :: Ctx CrucibleType).
CtxRepr ctx -> TypeRepr ('StructType ctx)
StructRepr Assignment TypeRepr x
tys)

someExprType :: SomeExpr ext s -> Maybe (Some TypeRepr)
someExprType :: forall ext s. SomeExpr ext s -> Maybe (Some TypeRepr)
someExprType (SomeE TypeRepr t
tpr E ext s t
_) = Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr t -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr t
tpr)
someExprType SomeExpr ext s
_ = Maybe (Some TypeRepr)
forall a. Maybe a
Nothing


findJointType :: Maybe (Some TypeRepr) -> [SomeExpr ext s] -> Maybe (Some TypeRepr)
findJointType :: forall ext s.
Maybe (Some TypeRepr) -> [SomeExpr ext s] -> Maybe (Some TypeRepr)
findJointType = (SomeExpr ext s -> Maybe (Some TypeRepr) -> Maybe (Some TypeRepr))
-> Maybe (Some TypeRepr)
-> [SomeExpr ext s]
-> Maybe (Some TypeRepr)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\SomeExpr ext s
y Maybe (Some TypeRepr)
x -> Maybe (Some TypeRepr)
-> Maybe (Some TypeRepr) -> Maybe (Some TypeRepr)
forall {a}. Maybe a -> Maybe a -> Maybe a
f Maybe (Some TypeRepr)
x (SomeExpr ext s -> Maybe (Some TypeRepr)
forall ext s. SomeExpr ext s -> Maybe (Some TypeRepr)
someExprType SomeExpr ext s
y))
 where
 f :: Maybe a -> Maybe a -> Maybe a
f Maybe a
Nothing Maybe a
y    = Maybe a
y
 f x :: Maybe a
x@(Just a
_) Maybe a
_ = Maybe a
x

evalOverloaded :: forall m s t ext. MonadSyntax Atomic m => AST s -> TypeRepr t -> Keyword -> [SomeExpr ext s] -> m (E ext s t)
evalOverloaded :: forall (m :: * -> *) s (t :: CrucibleType) ext.
MonadSyntax Atomic m =>
AST s -> TypeRepr t -> Keyword -> [SomeExpr ext s] -> m (E ext s t)
evalOverloaded AST s
ast TypeRepr t
tpr Keyword
k = AST s -> m (E ext s t) -> m (E ext s t)
forall a. AST s -> m a -> m a
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Syntax atom -> m a -> m a
withFocus AST s
ast (m (E ext s t) -> m (E ext s t))
-> ([SomeExpr ext s] -> m (E ext s t))
-> [SomeExpr ext s]
-> m (E ext s t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  case (Keyword
k, TypeRepr t
tpr) of
    (Keyword
Plus, TypeRepr t
NatRepr)     -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
nary E ext s t -> E ext s t -> App ext (E ext s) t
E ext s 'NatType -> E ext s 'NatType -> App ext (E ext s) 'NatType
forall (f :: CrucibleType -> *) ext.
f 'NatType -> f 'NatType -> App ext f 'NatType
NatAdd    (Natural -> App ext (E ext s) 'NatType
forall ext (f :: CrucibleType -> *). Natural -> App ext f 'NatType
NatLit Natural
0)
    (Keyword
Plus, TypeRepr t
IntegerRepr) -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
nary E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType BaseIntegerType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseIntegerType)
-> f ('BaseToType BaseIntegerType)
-> App ext f ('BaseToType BaseIntegerType)
IntAdd    (Integer -> App ext (E ext s) ('BaseToType BaseIntegerType)
forall ext (f :: CrucibleType -> *).
Integer -> App ext f ('BaseToType BaseIntegerType)
IntLit Integer
0)
    (Keyword
Plus, TypeRepr t
RealValRepr) -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
nary E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('BaseToType BaseRealType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseRealType)
-> f ('BaseToType BaseRealType)
-> App ext f ('BaseToType BaseRealType)
RealAdd   (Rational -> App ext (E ext s) ('BaseToType BaseRealType)
forall ext (f :: CrucibleType -> *).
Rational -> App ext f ('BaseToType BaseRealType)
RationalLit Rational
0)
    (Keyword
Plus, BVRepr NatRepr n
w)    -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
nary (NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType (BaseBVType n))
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAdd NatRepr n
w) (NatRepr n -> BV n -> App ext (E ext s) ('BaseToType (BaseBVType n))
forall (w :: Natural) ext (f :: CrucibleType -> *).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr n
w (NatRepr n -> BV n
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr n
w))

    (Keyword
Times, TypeRepr t
NatRepr)     -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
nary E ext s t -> E ext s t -> App ext (E ext s) t
E ext s 'NatType -> E ext s 'NatType -> App ext (E ext s) 'NatType
forall (f :: CrucibleType -> *) ext.
f 'NatType -> f 'NatType -> App ext f 'NatType
NatMul    (Natural -> App ext (E ext s) 'NatType
forall ext (f :: CrucibleType -> *). Natural -> App ext f 'NatType
NatLit Natural
1)
    (Keyword
Times, TypeRepr t
IntegerRepr) -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
nary E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType BaseIntegerType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseIntegerType)
-> f ('BaseToType BaseIntegerType)
-> App ext f ('BaseToType BaseIntegerType)
IntMul    (Integer -> App ext (E ext s) ('BaseToType BaseIntegerType)
forall ext (f :: CrucibleType -> *).
Integer -> App ext f ('BaseToType BaseIntegerType)
IntLit Integer
1)
    (Keyword
Times, TypeRepr t
RealValRepr) -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
nary E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('BaseToType BaseRealType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseRealType)
-> f ('BaseToType BaseRealType)
-> App ext f ('BaseToType BaseRealType)
RealMul   (Rational -> App ext (E ext s) ('BaseToType BaseRealType)
forall ext (f :: CrucibleType -> *).
Rational -> App ext f ('BaseToType BaseRealType)
RationalLit Rational
1)
    (Keyword
Times, BVRepr NatRepr n
w)    -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
nary (NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType (BaseBVType n))
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVMul NatRepr n
w) (NatRepr n -> BV n -> App ext (E ext s) ('BaseToType (BaseBVType n))
forall (w :: Natural) ext (f :: CrucibleType -> *).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr n
w (NatRepr n -> BV n
forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
BV.one NatRepr n
w))

    (Keyword
Minus, TypeRepr t
NatRepr)     -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
E ext s 'NatType -> E ext s 'NatType -> App ext (E ext s) 'NatType
forall (f :: CrucibleType -> *) ext.
f 'NatType -> f 'NatType -> App ext f 'NatType
NatSub
    (Keyword
Minus, TypeRepr t
IntegerRepr) -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType BaseIntegerType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseIntegerType)
-> f ('BaseToType BaseIntegerType)
-> App ext f ('BaseToType BaseIntegerType)
IntSub
    (Keyword
Minus, TypeRepr t
RealValRepr) -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('BaseToType BaseRealType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseRealType)
-> f ('BaseToType BaseRealType)
-> App ext f ('BaseToType BaseRealType)
RealSub
    (Keyword
Minus, BVRepr NatRepr n
w)    -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin (NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType (BaseBVType n))
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSub NatRepr n
w)

    (Keyword
Div, TypeRepr t
NatRepr)       -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
E ext s 'NatType -> E ext s 'NatType -> App ext (E ext s) 'NatType
forall (f :: CrucibleType -> *) ext.
f 'NatType -> f 'NatType -> App ext f 'NatType
NatDiv
    (Keyword
Div, TypeRepr t
IntegerRepr)   -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType BaseIntegerType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseIntegerType)
-> f ('BaseToType BaseIntegerType)
-> App ext f ('BaseToType BaseIntegerType)
IntDiv
    (Keyword
Div, TypeRepr t
RealValRepr)   -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('BaseToType BaseRealType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseRealType)
-> f ('BaseToType BaseRealType)
-> App ext f ('BaseToType BaseRealType)
RealDiv
    (Keyword
Div, BVRepr NatRepr n
w)      -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin (NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType (BaseBVType n))
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVUdiv NatRepr n
w)

    (Keyword
Mod, TypeRepr t
NatRepr)       -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
E ext s 'NatType -> E ext s 'NatType -> App ext (E ext s) 'NatType
forall (f :: CrucibleType -> *) ext.
f 'NatType -> f 'NatType -> App ext f 'NatType
NatMod
    (Keyword
Mod, TypeRepr t
IntegerRepr)   -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType BaseIntegerType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseIntegerType)
-> f ('BaseToType BaseIntegerType)
-> App ext f ('BaseToType BaseIntegerType)
IntMod
    (Keyword
Mod, TypeRepr t
RealValRepr)   -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('BaseToType BaseRealType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseRealType)
-> f ('BaseToType BaseRealType)
-> App ext f ('BaseToType BaseRealType)
RealMod
    (Keyword
Mod, BVRepr NatRepr n
w)      -> (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin (NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType (BaseBVType n))
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVUrem NatRepr n
w)

    (Keyword
Negate, TypeRepr t
IntegerRepr) -> (E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
u E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType BaseIntegerType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseIntegerType)
-> App ext f ('BaseToType BaseIntegerType)
IntNeg
    (Keyword
Negate, TypeRepr t
RealValRepr) -> (E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
u E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('BaseToType BaseRealType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseRealType)
-> App ext f ('BaseToType BaseRealType)
RealNeg
    (Keyword
Negate, BVRepr NatRepr n
w)    -> (E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
u (NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType (BaseBVType n))
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> App ext f (BVType w)
BVNeg NatRepr n
w)

    (Keyword
Abs, TypeRepr t
IntegerRepr)   -> (E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
u E ext s t -> App ext (E ext s) t
E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType BaseIntegerType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseIntegerType)
-> App ext f ('BaseToType BaseIntegerType)
IntAbs

    (Keyword, TypeRepr t)
_ -> \[SomeExpr ext s]
_ -> m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$ Text -> m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"operation at type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr t -> String
forall a. Show a => a -> String
show TypeRepr t
tpr)) (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$ m (E ext s t)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
 where
 u :: (E ext s t -> App ext (E ext s) t) -> [SomeExpr ext s] -> m (E ext s t)
 u :: (E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
u E ext s t -> App ext (E ext s) t
f [SomeExpr ext s
x] = App ext (E ext s) t -> E ext s t
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) t -> E ext s t)
-> (E ext s t -> App ext (E ext s) t) -> E ext s t -> E ext s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E ext s t -> App ext (E ext s) t
f (E ext s t -> E ext s t) -> m (E ext s t) -> m (E ext s t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRepr t -> SomeExpr ext s -> m (E ext s t)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr t
tpr SomeExpr ext s
x
 u E ext s t -> App ext (E ext s) t
_ [SomeExpr ext s]
_ = m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$ Text -> m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"one argument" (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$ m (E ext s t)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

 bin :: (E ext s t -> E ext s t -> App ext (E ext s) t) -> [SomeExpr ext s] -> m (E ext s t)
 bin :: (E ext s t -> E ext s t -> App ext (E ext s) t)
-> [SomeExpr ext s] -> m (E ext s t)
bin E ext s t -> E ext s t -> App ext (E ext s) t
f [SomeExpr ext s
x,SomeExpr ext s
y] = App ext (E ext s) t -> E ext s t
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) t -> E ext s t)
-> m (App ext (E ext s) t) -> m (E ext s t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (E ext s t -> E ext s t -> App ext (E ext s) t
f (E ext s t -> E ext s t -> App ext (E ext s) t)
-> m (E ext s t) -> m (E ext s t -> App ext (E ext s) t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRepr t -> SomeExpr ext s -> m (E ext s t)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr t
tpr SomeExpr ext s
x m (E ext s t -> App ext (E ext s) t)
-> m (E ext s t) -> m (App ext (E ext s) t)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeRepr t -> SomeExpr ext s -> m (E ext s t)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr t
tpr SomeExpr ext s
y)
 bin E ext s t -> E ext s t -> App ext (E ext s) t
_ [SomeExpr ext s]
_ = m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$ Text -> m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"two arguments" (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$ m (E ext s t)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

 nary :: (E ext s t -> E ext s t -> App ext (E ext s) t) -> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
 nary :: (E ext s t -> E ext s t -> App ext (E ext s) t)
-> App ext (E ext s) t -> [SomeExpr ext s] -> m (E ext s t)
nary E ext s t -> E ext s t -> App ext (E ext s) t
_ App ext (E ext s) t
z []     = E ext s t -> m (E ext s t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (E ext s t -> m (E ext s t)) -> E ext s t -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) t -> E ext s t
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp App ext (E ext s) t
z
 nary E ext s t -> E ext s t -> App ext (E ext s) t
_ App ext (E ext s) t
_ [SomeExpr ext s
x]    = TypeRepr t -> SomeExpr ext s -> m (E ext s t)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr t
tpr SomeExpr ext s
x
 nary E ext s t -> E ext s t -> App ext (E ext s) t
f App ext (E ext s) t
_ (SomeExpr ext s
x:[SomeExpr ext s]
xs) = (E ext s t -> E ext s t -> App ext (E ext s) t)
-> E ext s t -> [E ext s t] -> E ext s t
forall {ext} {s} {t :: CrucibleType} {t}.
(E ext s t -> t -> App ext (E ext s) t)
-> E ext s t -> [t] -> E ext s t
go E ext s t -> E ext s t -> App ext (E ext s) t
f (E ext s t -> [E ext s t] -> E ext s t)
-> m (E ext s t) -> m ([E ext s t] -> E ext s t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRepr t -> SomeExpr ext s -> m (E ext s t)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr t
tpr SomeExpr ext s
x m ([E ext s t] -> E ext s t) -> m [E ext s t] -> m (E ext s t)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SomeExpr ext s -> m (E ext s t))
-> [SomeExpr ext s] -> m [E ext s t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TypeRepr t -> SomeExpr ext s -> m (E ext s t)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr t
tpr) [SomeExpr ext s]
xs

 go :: (E ext s t -> t -> App ext (E ext s) t)
-> E ext s t -> [t] -> E ext s t
go E ext s t -> t -> App ext (E ext s) t
f E ext s t
x (t
y:[t]
ys) = (E ext s t -> t -> App ext (E ext s) t)
-> E ext s t -> [t] -> E ext s t
go E ext s t -> t -> App ext (E ext s) t
f (App ext (E ext s) t -> E ext s t
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) t -> E ext s t)
-> App ext (E ext s) t -> E ext s t
forall a b. (a -> b) -> a -> b
$ E ext s t -> t -> App ext (E ext s) t
f E ext s t
x t
y) [t]
ys
 go E ext s t -> t -> App ext (E ext s) t
_ E ext s t
x []     = E ext s t
x


evalSomeExpr :: MonadSyntax Atomic m => TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr :: forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr t
tpr (SomeE TypeRepr t
tpr' E ext s t
e)
  | Just t :~: t
Refl <- TypeRepr t -> TypeRepr t -> Maybe (t :~: t)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr t
tpr TypeRepr t
tpr' = E ext s t -> m (E ext s t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return E ext s t
E ext s t
e
  | Bool
otherwise = m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$ Text -> m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"matching types (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr t -> String
forall a. Show a => a -> String
show TypeRepr t
tpr)
                                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" /= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr t -> String
forall a. Show a => a -> String
show TypeRepr t
tpr') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (E ext s t)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
evalSomeExpr TypeRepr t
tpr (SomeOverloaded AST s
ast Keyword
k [SomeExpr ext s]
args) = AST s -> TypeRepr t -> Keyword -> [SomeExpr ext s] -> m (E ext s t)
forall (m :: * -> *) s (t :: CrucibleType) ext.
MonadSyntax Atomic m =>
AST s -> TypeRepr t -> Keyword -> [SomeExpr ext s] -> m (E ext s t)
evalOverloaded AST s
ast TypeRepr t
tpr Keyword
k [SomeExpr ext s]
args
evalSomeExpr TypeRepr t
tpr (SomeIntLiteral AST s
ast Integer
i) = AST s -> TypeRepr t -> Integer -> m (E ext s t)
forall (m :: * -> *) s (tpr :: CrucibleType) ext.
MonadSyntax Atomic m =>
AST s -> TypeRepr tpr -> Integer -> m (E ext s tpr)
evalIntLiteral AST s
ast TypeRepr t
tpr Integer
i

applyOverloaded ::
  MonadSyntax Atomic m => AST s -> Keyword -> Maybe (Some TypeRepr) -> [SomeExpr ext s] -> m (SomeExpr ext s)
applyOverloaded :: forall (m :: * -> *) s ext.
MonadSyntax Atomic m =>
AST s
-> Keyword
-> Maybe (Some TypeRepr)
-> [SomeExpr ext s]
-> m (SomeExpr ext s)
applyOverloaded AST s
ast Keyword
k Maybe (Some TypeRepr)
mtp [SomeExpr ext s]
args =
  case Maybe (Some TypeRepr) -> [SomeExpr ext s] -> Maybe (Some TypeRepr)
forall ext s.
Maybe (Some TypeRepr) -> [SomeExpr ext s] -> Maybe (Some TypeRepr)
findJointType Maybe (Some TypeRepr)
mtp [SomeExpr ext s]
args of
    Maybe (Some TypeRepr)
Nothing -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ AST s -> Keyword -> [SomeExpr ext s] -> SomeExpr ext s
forall s ext.
AST s -> Keyword -> [SomeExpr ext s] -> SomeExpr ext s
SomeOverloaded AST s
ast Keyword
k [SomeExpr ext s]
args
    Just (Some TypeRepr x
tp) -> TypeRepr x -> E ext s x -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr x
tp (E ext s x -> SomeExpr ext s)
-> m (E ext s x) -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AST s -> TypeRepr x -> Keyword -> [SomeExpr ext s] -> m (E ext s x)
forall (m :: * -> *) s (t :: CrucibleType) ext.
MonadSyntax Atomic m =>
AST s -> TypeRepr t -> Keyword -> [SomeExpr ext s] -> m (E ext s t)
evalOverloaded AST s
ast TypeRepr x
tp Keyword
k [SomeExpr ext s]
args

evalIntLiteral :: MonadSyntax Atomic m => AST s -> TypeRepr tpr -> Integer -> m (E ext s tpr)
evalIntLiteral :: forall (m :: * -> *) s (tpr :: CrucibleType) ext.
MonadSyntax Atomic m =>
AST s -> TypeRepr tpr -> Integer -> m (E ext s tpr)
evalIntLiteral AST s
_ TypeRepr tpr
NatRepr Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = E ext s tpr -> m (E ext s tpr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (E ext s tpr -> m (E ext s tpr)) -> E ext s tpr -> m (E ext s tpr)
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) tpr -> E ext s tpr
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) tpr -> E ext s tpr)
-> App ext (E ext s) tpr -> E ext s tpr
forall a b. (a -> b) -> a -> b
$ Natural -> App ext (E ext s) 'NatType
forall ext (f :: CrucibleType -> *). Natural -> App ext f 'NatType
NatLit (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
i)
evalIntLiteral AST s
_ TypeRepr tpr
IntegerRepr Integer
i = E ext s tpr -> m (E ext s tpr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (E ext s tpr -> m (E ext s tpr)) -> E ext s tpr -> m (E ext s tpr)
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) tpr -> E ext s tpr
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) tpr -> E ext s tpr)
-> App ext (E ext s) tpr -> E ext s tpr
forall a b. (a -> b) -> a -> b
$ Integer -> App ext (E ext s) ('BaseToType BaseIntegerType)
forall ext (f :: CrucibleType -> *).
Integer -> App ext f ('BaseToType BaseIntegerType)
IntLit Integer
i
evalIntLiteral AST s
_ TypeRepr tpr
RealValRepr Integer
i = E ext s tpr -> m (E ext s tpr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (E ext s tpr -> m (E ext s tpr)) -> E ext s tpr -> m (E ext s tpr)
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) tpr -> E ext s tpr
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) tpr -> E ext s tpr)
-> App ext (E ext s) tpr -> E ext s tpr
forall a b. (a -> b) -> a -> b
$ Rational -> App ext (E ext s) ('BaseToType BaseRealType)
forall ext (f :: CrucibleType -> *).
Rational -> App ext f ('BaseToType BaseRealType)
RationalLit (Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
i)
evalIntLiteral AST s
ast TypeRepr tpr
tpr Integer
_i =
  AST s -> m (E ext s tpr) -> m (E ext s tpr)
forall a. AST s -> m a -> m a
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Syntax atom -> m a -> m a
withFocus AST s
ast (m (E ext s tpr) -> m (E ext s tpr))
-> m (E ext s tpr) -> m (E ext s tpr)
forall a b. (a -> b) -> a -> b
$ m (E ext s tpr) -> m (E ext s tpr)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (E ext s tpr) -> m (E ext s tpr))
-> m (E ext s tpr) -> m (E ext s tpr)
forall a b. (a -> b) -> a -> b
$ Text -> m (E ext s tpr) -> m (E ext s tpr)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"literal " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tpr -> String
forall a. Show a => a -> String
show TypeRepr tpr
tpr) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" value") m (E ext s tpr)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

forceSynth :: MonadSyntax Atomic m => SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth :: forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeE TypeRepr t
tp E ext s t
e) = Pair TypeRepr (E ext s) -> m (Pair TypeRepr (E ext s))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pair TypeRepr (E ext s) -> m (Pair TypeRepr (E ext s)))
-> Pair TypeRepr (E ext s) -> m (Pair TypeRepr (E ext s))
forall a b. (a -> b) -> a -> b
$ TypeRepr t -> E ext s t -> Pair TypeRepr (E ext s)
forall {k} (a :: k -> *) (tp :: k) (b :: k -> *).
a tp -> b tp -> Pair a b
Pair TypeRepr t
tp E ext s t
e
forceSynth (SomeOverloaded AST s
ast Keyword
_ [SomeExpr ext s]
_) =
  AST s -> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall a. AST s -> m a -> m a
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Syntax atom -> m a -> m a
withFocus AST s
ast (m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s)))
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall a b. (a -> b) -> a -> b
$ m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (Text -> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"unambiguous expression (add type annotation to disambiguate)" m (Pair TypeRepr (E ext s))
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty)
forceSynth (SomeIntLiteral AST s
ast Integer
_) =
  AST s -> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall a. AST s -> m a -> m a
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Syntax atom -> m a -> m a
withFocus AST s
ast (m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s)))
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall a b. (a -> b) -> a -> b
$ m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (Text -> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"unambiguous numeric literal (add type annotation to disambiguate)" m (Pair TypeRepr (E ext s))
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty)

synth
  :: forall m s ext
   . ( MonadReader (SyntaxState s) m
     , MonadSyntax Atomic m
     , ?parserHooks :: ParserHooks ext )
  => m (Pair TypeRepr (E ext s))
synth :: forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth = SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth'

synth' :: forall m s ext
        .  ( MonadReader (SyntaxState s) m
           , MonadSyntax Atomic m
           , ?parserHooks :: ParserHooks ext )
       => m (SomeExpr ext s)
synth' :: forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth' = Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
forall a. Maybe a
Nothing

synthExpr :: forall m s ext
           . ( MonadReader (SyntaxState s) m
             , MonadSyntax Atomic m
             , ?parserHooks :: ParserHooks ext )
          => Maybe (Some TypeRepr)
          -> m (SomeExpr ext s)
synthExpr :: forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint =
  Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"expression" (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
    m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (m (SomeExpr ext s)
the m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
crucibleAtom m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
regRef m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
globRef m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
deref m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
bvExpr m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     Keyword
-> (E ext s ('BaseToType BaseBoolType)
    -> E ext s ('BaseToType BaseBoolType)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> Bool
-> m (SomeExpr ext s)
forall {m :: * -> *} {s} {ext}.
(MonadSyntax Atomic m, MonadReader (SyntaxState s) m,
 ?parserHooks::ParserHooks ext) =>
Keyword
-> (E ext s ('BaseToType BaseBoolType)
    -> E ext s ('BaseToType BaseBoolType)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> Bool
-> m (SomeExpr ext s)
naryBool Keyword
And_ E ext s ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseBoolType)
-> f ('BaseToType BaseBoolType)
-> App ext f ('BaseToType BaseBoolType)
And Bool
True m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (E ext s ('BaseToType BaseBoolType)
    -> E ext s ('BaseToType BaseBoolType)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> Bool
-> m (SomeExpr ext s)
forall {m :: * -> *} {s} {ext}.
(MonadSyntax Atomic m, MonadReader (SyntaxState s) m,
 ?parserHooks::ParserHooks ext) =>
Keyword
-> (E ext s ('BaseToType BaseBoolType)
    -> E ext s ('BaseToType BaseBoolType)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> Bool
-> m (SomeExpr ext s)
naryBool Keyword
Or_ E ext s ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseBoolType)
-> f ('BaseToType BaseBoolType)
-> App ext f ('BaseToType BaseBoolType)
Or Bool
False m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (E ext s ('BaseToType BaseBoolType)
    -> E ext s ('BaseToType BaseBoolType)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> Bool
-> m (SomeExpr ext s)
forall {m :: * -> *} {s} {ext}.
(MonadSyntax Atomic m, MonadReader (SyntaxState s) m,
 ?parserHooks::ParserHooks ext) =>
Keyword
-> (E ext s ('BaseToType BaseBoolType)
    -> E ext s ('BaseToType BaseBoolType)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> Bool
-> m (SomeExpr ext s)
naryBool Keyword
Xor_ E ext s ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseBoolType)
-> f ('BaseToType BaseBoolType)
-> App ext f ('BaseToType BaseBoolType)
BoolXor Bool
False m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     Keyword -> m (SomeExpr ext s)
unaryArith Keyword
Negate m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword -> m (SomeExpr ext s)
unaryArith Keyword
Abs m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     Keyword -> m (SomeExpr ext s)
naryArith Keyword
Plus m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword -> m (SomeExpr ext s)
binaryArith Keyword
Minus m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword -> m (SomeExpr ext s)
naryArith Keyword
Times m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword -> m (SomeExpr ext s)
binaryArith Keyword
Div m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword -> m (SomeExpr ext s)
binaryArith Keyword
Mod m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
forall {ext} {s}. m (SomeExpr ext s)
unitCon m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
forall {ext} {s}. m (SomeExpr ext s)
boolLit m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
forall {ext} {s}. m (SomeExpr ext s)
stringLit m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
forall {ext} {s}. m (SomeExpr ext s)
funNameLit m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
notExpr m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
equalp m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
lessThan m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
lessThanEq m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
toAny m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
fromAny m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
stringAppend m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
forall {ext} {s}. m (SomeExpr ext s)
stringEmpty m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
stringLength m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
showExpr m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
just m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
nothing m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
fromJust_ m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
injection m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
projection m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
vecLit m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
vecCons m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
vecRep m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
vecLen m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
vecEmptyP m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
vecGet m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
vecSet m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
struct m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
getField m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
setField m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
seqNil m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
seqCons m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
seqAppend m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
seqNilP m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
seqLen m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
seqHead m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
seqTail m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
seqUncons m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
ite m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>  m (SomeExpr ext s)
intLit m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
forall {ext} {s}. m (SomeExpr ext s)
rationalLit m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
intp m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
binaryToFp m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
fpToBinary m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
realToFp m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
fpToReal m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     m (SomeExpr ext s)
ubvToFloat m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
floatToUBV m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
sbvToFloat m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeExpr ext s)
floatToSBV m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> m (SomeExpr ext s)
unaryBV Keyword
BVNonzero_ NatRepr w
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> App ext f ('BaseToType BaseBoolType)
BVNonzero m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> m (SomeExpr ext s)
compareBV Keyword
BVCarry_ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w
-> f (BVType w)
-> f (BVType w)
-> App ext f ('BaseToType BaseBoolType)
BVCarry m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> m (SomeExpr ext s)
compareBV Keyword
BVSCarry_ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w
-> f (BVType w)
-> f (BVType w)
-> App ext f ('BaseToType BaseBoolType)
BVSCarry m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> m (SomeExpr ext s)
compareBV Keyword
BVSBorrow_ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w
-> f (BVType w)
-> f (BVType w)
-> App ext f ('BaseToType BaseBoolType)
BVSBorrow m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
     Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> m (SomeExpr ext s)
compareBV Keyword
Slt NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w
-> f (BVType w)
-> f (BVType w)
-> App ext f ('BaseToType BaseBoolType)
BVSlt m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> m (SomeExpr ext s)
compareBV Keyword
Sle NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w
-> f (BVType w)
-> f (BVType w)
-> App ext f ('BaseToType BaseBoolType)
BVSle)

-- Syntactic constructs still to add (see issue #74)

-- BvToInteger, SbvToInteger, BvToNat
-- NatToInteger, IntegerToReal
-- RealRound, RealFloor, RealCeil
-- IntegerToBV, RealToNat

-- EmptyWordMap, InsertWordMap, LookupWordMap, LookupWordMapWithDefault
-- EmptyStringMap, LookupStringMapEntry, InsertStringMapEntry
-- SymArrayLookup, SymArrayUpdate
-- Complex, RealPart, ImagPart
-- IsConcrete
-- Closure
-- All the floating-point operations
-- What to do about RollRecursive, UnrollRecursive?
-- AddSideCondition????
-- BVUndef ????

  where
    the :: m (SomeExpr ext s)
    the :: m (SomeExpr ext s)
the = do Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"type-annotated expression" (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
               Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
The m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
                 (m (Some TypeRepr)
-> (Some TypeRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType ((Some TypeRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (Some TypeRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
                  \(Some TypeRepr x
t) ->
                    do (E ext s x
e, ()) <- m (E ext s x) -> m () -> m (E ext s x, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (TypeRepr x -> m (E ext s x)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr x
t) m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
                       SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr x -> E ext s x -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr x
t E ext s x
e)

    okAtom :: Map k (Some (Atom s)) -> k -> Maybe (SomeExpr ext s)
okAtom Map k (Some (Atom s))
theAtoms k
x =
      case k -> Map k (Some (Atom s)) -> Maybe (Some (Atom s))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
x Map k (Some (Atom s))
theAtoms of
        Maybe (Some (Atom s))
Nothing -> Maybe (SomeExpr ext s)
forall a. Maybe a
Nothing
        Just (Some Atom s x
anAtom) -> SomeExpr ext s -> Maybe (SomeExpr ext s)
forall a. a -> Maybe a
Just (SomeExpr ext s -> Maybe (SomeExpr ext s))
-> SomeExpr ext s -> Maybe (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr x -> E ext s x -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (Atom s x -> TypeRepr x
forall s (tp :: CrucibleType). Atom s tp -> TypeRepr tp
typeOfAtom Atom s x
anAtom) (Atom s x -> E ext s x
forall s (t :: CrucibleType) ext. Atom s t -> E ext s t
EAtom Atom s x
anAtom)

    regRef :: m (SomeExpr ext s)
    regRef :: m (SomeExpr ext s)
regRef =
      do Some Reg s x
r <- m (Some (Reg s))
forall (m :: * -> *) s.
(MonadSyntax Atomic m, MonadReader (SyntaxState s) m) =>
m (Some (Reg s))
regRef'
         Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRepr x -> E ext s x -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (Reg s x -> TypeRepr x
forall s (tp :: CrucibleType). Reg s tp -> TypeRepr tp
typeOfReg Reg s x
r) (Position -> Reg s x -> E ext s x
forall s (t :: CrucibleType) ext. Position -> Reg s t -> E ext s t
EReg Position
loc Reg s x
r))

    deref :: m (SomeExpr ext s)
    deref :: m (SomeExpr ext s)
deref =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some TypeRepr x
t) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr ('ReferenceType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr x -> TypeRepr ('ReferenceType x)
forall (a :: CrucibleType).
TypeRepr a -> TypeRepr ('ReferenceType a)
ReferenceRepr TypeRepr x
t))
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Deref (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint) m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
           Pair (ReferenceRepr TypeRepr a
t') E ext s tp
e ->
             do Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
                SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRepr a -> E ext s a -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr a
t' (Position -> E ext s ('ReferenceType a) -> E ext s a
forall ext s (t :: CrucibleType).
Position -> E ext s (ReferenceType t) -> E ext s t
EDeref Position
loc E ext s tp
E ext s ('ReferenceType a)
e))
           Pair TypeRepr tp
notRef E ext s tp
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"reference type (provided a "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
notRef) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    globRef :: m (SomeExpr ext s)
    globRef :: m (SomeExpr ext s)
globRef =
      do Some GlobalVar x
g <- m (Some GlobalVar)
forall (m :: * -> *) s.
(MonadSyntax Atomic m, MonadReader (SyntaxState s) m) =>
m (Some GlobalVar)
globRef'
         Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeRepr x -> E ext s x -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (GlobalVar x -> TypeRepr x
forall (tp :: CrucibleType). GlobalVar tp -> TypeRepr tp
globalType GlobalVar x
g) (Position -> GlobalVar x -> E ext s x
forall (t :: CrucibleType) ext s.
Position -> GlobalVar t -> E ext s t
EGlob Position
loc GlobalVar x
g))

    crucibleAtom :: m (SomeExpr ext s)
    crucibleAtom :: m (SomeExpr ext s)
crucibleAtom =
      do Map AtomName (Some (Atom s))
theAtoms <- Getting
  (Map AtomName (Some (Atom s)))
  (SyntaxState s)
  (Map AtomName (Some (Atom s)))
-> m (Map AtomName (Some (Atom s)))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Map AtomName (Some (Atom s)))
  (SyntaxState s)
  (Map AtomName (Some (Atom s)))
forall s (f :: * -> *).
Functor f =>
(Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
-> SyntaxState s -> f (SyntaxState s)
stxAtoms
         Text
-> (AtomName -> Maybe (SomeExpr ext s))
-> m AtomName
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"known atom" (Map AtomName (Some (Atom s)) -> AtomName -> Maybe (SomeExpr ext s)
forall {k} {s} {ext}.
Ord k =>
Map k (Some (Atom s)) -> k -> Maybe (SomeExpr ext s)
okAtom Map AtomName (Some (Atom s))
theAtoms) m AtomName
forall (m :: * -> *). MonadSyntax Atomic m => m AtomName
atomName

    unitCon :: m (SomeExpr ext s)
unitCon = Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"unit constructor" (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m () -> SomeExpr ext s -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TypeRepr 'UnitType -> E ext s 'UnitType -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr 'UnitType
UnitRepr (App ext (E ext s) 'UnitType -> E ext s 'UnitType
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp App ext (E ext s) 'UnitType
forall ext (f :: CrucibleType -> *). App ext f 'UnitType
EmptyApp))

    boolLit :: m (SomeExpr ext s)
boolLit = m Bool
forall (m :: * -> *). MonadSyntax Atomic m => m Bool
bool m Bool -> (Bool -> SomeExpr ext s) -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> (Bool -> E ext s ('BaseToType BaseBoolType))
-> Bool
-> SomeExpr ext s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> (Bool -> App ext (E ext s) ('BaseToType BaseBoolType))
-> Bool
-> E ext s ('BaseToType BaseBoolType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> App ext (E ext s) ('BaseToType BaseBoolType)
forall ext (f :: CrucibleType -> *).
Bool -> App ext f ('BaseToType BaseBoolType)
BoolLit

    stringLit :: m (SomeExpr ext s)
stringLit = m Text
forall (m :: * -> *). MonadSyntax Atomic m => m Text
string m Text -> (Text -> SomeExpr ext s) -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr) (E ext s ('BaseToType (BaseStringType 'Unicode)) -> SomeExpr ext s)
-> (Text -> E ext s ('BaseToType (BaseStringType 'Unicode)))
-> Text
-> SomeExpr ext s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
 -> E ext s ('BaseToType (BaseStringType 'Unicode)))
-> (Text
    -> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode)))
-> Text
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral 'Unicode
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo) ext (f :: CrucibleType -> *).
StringLiteral si -> App ext f ('BaseToType (BaseStringType si))
StringLit (StringLiteral 'Unicode
 -> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode)))
-> (Text -> StringLiteral 'Unicode)
-> Text
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StringLiteral 'Unicode
UnicodeLiteral

    intLit :: m (SomeExpr ext s)
intLit =
      do AST s
ast <- m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
         case Maybe (Some TypeRepr)
typeHint of
           Just (Some TypeRepr x
tpr) -> TypeRepr x -> E ext s x -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr x
tpr (E ext s x -> SomeExpr ext s)
-> m (E ext s x) -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AST s -> TypeRepr x -> Integer -> m (E ext s x)
forall (m :: * -> *) s (tpr :: CrucibleType) ext.
MonadSyntax Atomic m =>
AST s -> TypeRepr tpr -> Integer -> m (E ext s tpr)
evalIntLiteral AST s
ast TypeRepr x
tpr (Integer -> m (E ext s x)) -> m Integer -> m (E ext s x)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Integer
forall (m :: * -> *). MonadSyntax Atomic m => m Integer
int)
           Maybe (Some TypeRepr)
Nothing         -> AST s -> Integer -> SomeExpr ext s
forall s ext. AST s -> Integer -> SomeExpr ext s
SomeIntLiteral AST s
ast (Integer -> SomeExpr ext s) -> m Integer -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Integer
forall (m :: * -> *). MonadSyntax Atomic m => m Integer
int

    rationalLit :: m (SomeExpr ext s)
rationalLit = m Rational
forall (m :: * -> *). MonadSyntax Atomic m => m Rational
rational m Rational -> (Rational -> SomeExpr ext s) -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TypeRepr ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseRealType)
RealValRepr (E ext s ('BaseToType BaseRealType) -> SomeExpr ext s)
-> (Rational -> E ext s ('BaseToType BaseRealType))
-> Rational
-> SomeExpr ext s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App ext (E ext s) ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseRealType)
 -> E ext s ('BaseToType BaseRealType))
-> (Rational -> App ext (E ext s) ('BaseToType BaseRealType))
-> Rational
-> E ext s ('BaseToType BaseRealType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> App ext (E ext s) ('BaseToType BaseRealType)
forall ext (f :: CrucibleType -> *).
Rational -> App ext f ('BaseToType BaseRealType)
RationalLit

    naryBool :: Keyword
-> (E ext s ('BaseToType BaseBoolType)
    -> E ext s ('BaseToType BaseBoolType)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> Bool
-> m (SomeExpr ext s)
naryBool Keyword
k E ext s ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
f Bool
u =
      do ((), [E ext s ('BaseToType BaseBoolType)]
args) <- m ()
-> m [E ext s ('BaseToType BaseBoolType)]
-> m ((), [E ext s ('BaseToType BaseBoolType)])
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
k) (m (E ext s ('BaseToType BaseBoolType))
-> m [E ext s ('BaseToType BaseBoolType)]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m [a]
rep (TypeRepr ('BaseToType BaseBoolType)
-> m (E ext s ('BaseToType BaseBoolType))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ('BaseToType BaseBoolType)
BoolRepr))
         case [E ext s ('BaseToType BaseBoolType)]
args of
           [] -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (Bool -> App ext (E ext s) ('BaseToType BaseBoolType)
forall ext (f :: CrucibleType -> *).
Bool -> App ext f ('BaseToType BaseBoolType)
BoolLit Bool
u)
           (E ext s ('BaseToType BaseBoolType)
x:[E ext s ('BaseToType BaseBoolType)]
xs) -> E ext s ('BaseToType BaseBoolType)
-> [E ext s ('BaseToType BaseBoolType)] -> m (SomeExpr ext s)
go E ext s ('BaseToType BaseBoolType)
x [E ext s ('BaseToType BaseBoolType)]
xs

      where
      go :: E ext s ('BaseToType BaseBoolType)
-> [E ext s ('BaseToType BaseBoolType)] -> m (SomeExpr ext s)
go E ext s ('BaseToType BaseBoolType)
x [] = SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr E ext s ('BaseToType BaseBoolType)
x
      go E ext s ('BaseToType BaseBoolType)
x (E ext s ('BaseToType BaseBoolType)
y:[E ext s ('BaseToType BaseBoolType)]
ys) = E ext s ('BaseToType BaseBoolType)
-> [E ext s ('BaseToType BaseBoolType)] -> m (SomeExpr ext s)
go (App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
f E ext s ('BaseToType BaseBoolType)
x E ext s ('BaseToType BaseBoolType)
y) [E ext s ('BaseToType BaseBoolType)]
ys

    bvExpr :: m (SomeExpr ext s)
    bvExpr :: m (SomeExpr ext s)
bvExpr =
      do let nathint :: NatHint
nathint = case Maybe (Some TypeRepr)
typeHint of Just (Some (BVRepr NatRepr n
w)) -> NatRepr n -> NatHint
forall (w :: Natural). (1 <= w) => NatRepr w -> NatHint
NatHint NatRepr n
w; Maybe (Some TypeRepr)
_ -> NatHint
NoHint
         SomeBVExpr NatRepr w
w E ext s (BVType w)
x <- NatHint -> m (SomeBVExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
NatHint -> m (SomeBVExpr ext s)
synthBV NatHint
nathint
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr (BVType w) -> E ext s (BVType w) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (NatRepr w -> TypeRepr (BVType w)
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr w
w) E ext s (BVType w)
x

    intp :: m (SomeExpr ext s)
intp =
      do E ext s ('BaseToType BaseRealType)
e <- Keyword
-> m (E ext s ('BaseToType BaseRealType))
-> m (E ext s ('BaseToType BaseRealType))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Integerp (TypeRepr ('BaseToType BaseRealType)
-> m (E ext s ('BaseToType BaseRealType))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ('BaseToType BaseRealType)
RealValRepr)
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseRealType)
-> App ext f ('BaseToType BaseBoolType)
RealIsInteger E ext s ('BaseToType BaseRealType)
e

    funNameLit :: m (SomeExpr ext s)
funNameLit =
      do FunctionName
fn <- m FunctionName
forall (m :: * -> *). MonadSyntax Atomic m => m FunctionName
funName
         Maybe FunctionHeader
fh <- Getting
  (Maybe FunctionHeader) (SyntaxState s) (Maybe FunctionHeader)
-> m (Maybe FunctionHeader)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   (Maybe FunctionHeader) (SyntaxState s) (Maybe FunctionHeader)
 -> m (Maybe FunctionHeader))
-> Getting
     (Maybe FunctionHeader) (SyntaxState s) (Maybe FunctionHeader)
-> m (Maybe FunctionHeader)
forall a b. (a -> b) -> a -> b
$ (Map FunctionName FunctionHeader
 -> Const (Maybe FunctionHeader) (Map FunctionName FunctionHeader))
-> SyntaxState s -> Const (Maybe FunctionHeader) (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> SyntaxState s -> f (SyntaxState s)
stxFunctions ((Map FunctionName FunctionHeader
  -> Const (Maybe FunctionHeader) (Map FunctionName FunctionHeader))
 -> SyntaxState s -> Const (Maybe FunctionHeader) (SyntaxState s))
-> ((Maybe FunctionHeader
     -> Const (Maybe FunctionHeader) (Maybe FunctionHeader))
    -> Map FunctionName FunctionHeader
    -> Const (Maybe FunctionHeader) (Map FunctionName FunctionHeader))
-> Getting
     (Maybe FunctionHeader) (SyntaxState s) (Maybe FunctionHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map FunctionName FunctionHeader)
-> Lens'
     (Map FunctionName FunctionHeader)
     (Maybe (IxValue (Map FunctionName FunctionHeader)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map FunctionName FunctionHeader)
FunctionName
fn
         Maybe FunctionHeader
dh <- Getting
  (Maybe FunctionHeader) (SyntaxState s) (Maybe FunctionHeader)
-> m (Maybe FunctionHeader)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   (Maybe FunctionHeader) (SyntaxState s) (Maybe FunctionHeader)
 -> m (Maybe FunctionHeader))
-> Getting
     (Maybe FunctionHeader) (SyntaxState s) (Maybe FunctionHeader)
-> m (Maybe FunctionHeader)
forall a b. (a -> b) -> a -> b
$ (Map FunctionName FunctionHeader
 -> Const (Maybe FunctionHeader) (Map FunctionName FunctionHeader))
-> SyntaxState s -> Const (Maybe FunctionHeader) (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> SyntaxState s -> f (SyntaxState s)
stxForwardDecs ((Map FunctionName FunctionHeader
  -> Const (Maybe FunctionHeader) (Map FunctionName FunctionHeader))
 -> SyntaxState s -> Const (Maybe FunctionHeader) (SyntaxState s))
-> ((Maybe FunctionHeader
     -> Const (Maybe FunctionHeader) (Maybe FunctionHeader))
    -> Map FunctionName FunctionHeader
    -> Const (Maybe FunctionHeader) (Map FunctionName FunctionHeader))
-> Getting
     (Maybe FunctionHeader) (SyntaxState s) (Maybe FunctionHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map FunctionName FunctionHeader)
-> Lens'
     (Map FunctionName FunctionHeader)
     (Maybe (IxValue (Map FunctionName FunctionHeader)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map FunctionName FunctionHeader)
FunctionName
fn
         Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"known function name" (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
           -- First look for a function with the given name, and failing that,
           -- look for a forward declaration with the given name.
           case Maybe FunctionHeader
fh Maybe FunctionHeader
-> Maybe FunctionHeader -> Maybe FunctionHeader
forall {a}. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FunctionHeader
dh of
             Maybe FunctionHeader
Nothing -> m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
             Just (FunctionHeader FunctionName
_ Assignment Arg args
funArgs TypeRepr ret
ret FnHandle args ret
handle Position
_) ->
               SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('FunctionHandleType args ret)
-> E ext s ('FunctionHandleType args ret) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (CtxRepr args
-> TypeRepr ret -> TypeRepr ('FunctionHandleType args ret)
forall (ctx :: Ctx CrucibleType) (ret :: CrucibleType).
CtxRepr ctx
-> TypeRepr ret -> TypeRepr ('FunctionHandleType ctx ret)
FunctionHandleRepr (Assignment Arg args -> CtxRepr args
forall (init :: Ctx CrucibleType).
Assignment Arg init -> Assignment TypeRepr init
argTypes Assignment Arg args
funArgs) TypeRepr ret
ret) (App ext (E ext s) ('FunctionHandleType args ret)
-> E ext s ('FunctionHandleType args ret)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('FunctionHandleType args ret)
 -> E ext s ('FunctionHandleType args ret))
-> App ext (E ext s) ('FunctionHandleType args ret)
-> E ext s ('FunctionHandleType args ret)
forall a b. (a -> b) -> a -> b
$ FnHandle args ret
-> App ext (E ext s) ('FunctionHandleType args ret)
forall (args :: Ctx CrucibleType) (ret :: CrucibleType) ext
       (f :: CrucibleType -> *).
FnHandle args ret -> App ext f ('FunctionHandleType args ret)
HandleLit FnHandle args ret
handle)

    notExpr :: m (SomeExpr ext s)
notExpr =
      do E ext s ('BaseToType BaseBoolType)
e <- Text
-> m (E ext s ('BaseToType BaseBoolType))
-> m (E ext s ('BaseToType BaseBoolType))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"negation expression" (m (E ext s ('BaseToType BaseBoolType))
 -> m (E ext s ('BaseToType BaseBoolType)))
-> m (E ext s ('BaseToType BaseBoolType))
-> m (E ext s ('BaseToType BaseBoolType))
forall a b. (a -> b) -> a -> b
$ Keyword
-> m (E ext s ('BaseToType BaseBoolType))
-> m (E ext s ('BaseToType BaseBoolType))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Not_ (TypeRepr ('BaseToType BaseBoolType)
-> m (E ext s ('BaseToType BaseBoolType))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ('BaseToType BaseBoolType)
BoolRepr)
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s ('BaseToType BaseBoolType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseBoolType)
-> App ext f ('BaseToType BaseBoolType)
Not E ext s ('BaseToType BaseBoolType)
e

    matchingExprs ::
      Maybe (Some TypeRepr) -> SomeExpr ext s -> SomeExpr ext s ->
      (forall tp. TypeRepr tp -> E ext s tp -> E ext s tp -> m a) ->
      m a
    matchingExprs :: forall a.
Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall (tp :: CrucibleType).
    TypeRepr tp -> E ext s tp -> E ext s tp -> m a)
-> m a
matchingExprs Maybe (Some TypeRepr)
h SomeExpr ext s
e1 SomeExpr ext s
e2 forall (tp :: CrucibleType).
TypeRepr tp -> E ext s tp -> E ext s tp -> m a
k =
      case Maybe (Some TypeRepr) -> [SomeExpr ext s] -> Maybe (Some TypeRepr)
forall ext s.
Maybe (Some TypeRepr) -> [SomeExpr ext s] -> Maybe (Some TypeRepr)
findJointType Maybe (Some TypeRepr)
h [SomeExpr ext s
e1,SomeExpr ext s
e2] of
        Just (Some TypeRepr x
tp) ->
          do E ext s x
e1' <- TypeRepr x -> SomeExpr ext s -> m (E ext s x)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr x
tp SomeExpr ext s
e1
             E ext s x
e2' <- TypeRepr x -> SomeExpr ext s -> m (E ext s x)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr x
tp SomeExpr ext s
e2
             TypeRepr x -> E ext s x -> E ext s x -> m a
forall (tp :: CrucibleType).
TypeRepr tp -> E ext s tp -> E ext s tp -> m a
k TypeRepr x
tp E ext s x
e1' E ext s x
e2'
        Maybe (Some TypeRepr)
Nothing ->
          m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ Text -> m a -> m a
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"type annotation required to disambiguate types") m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    equalp :: m (SomeExpr ext s)
    equalp :: m (SomeExpr ext s)
equalp =
      do (SomeExpr ext s
e1, SomeExpr ext s
e2) <- Text
-> m (SomeExpr ext s, SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"equality test" (m (SomeExpr ext s, SomeExpr ext s)
 -> m (SomeExpr ext s, SomeExpr ext s))
-> m (SomeExpr ext s, SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Keyword
-> m (SomeExpr ext s)
-> m (SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
Equalp m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth' m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth'
         Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a.
Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall (tp :: CrucibleType).
    TypeRepr tp -> E ext s tp -> E ext s tp -> m a)
-> m a
matchingExprs Maybe (Some TypeRepr)
forall a. Maybe a
Nothing SomeExpr ext s
e1 SomeExpr ext s
e2 ((forall {tp :: CrucibleType}.
  TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
tp E ext s tp
e1' E ext s tp
e2' ->
          case TypeRepr tp
tp of
            FloatRepr FloatInfoRepr flt
_fi ->
              SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s ('FloatType flt)
-> E ext s ('FloatType flt)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) (fi :: FloatInfo) ext.
f (FloatType fi)
-> f (FloatType fi) -> App ext f ('BaseToType BaseBoolType)
FloatEq E ext s tp
E ext s ('FloatType flt)
e1' E ext s tp
E ext s ('FloatType flt)
e2'
            ReferenceRepr TypeRepr a
rtp ->
              SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ TypeRepr a
-> E ext s ('ReferenceType a)
-> E ext s ('ReferenceType a)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1
-> f (ReferenceType tp1)
-> f (ReferenceType tp1)
-> App ext f ('BaseToType BaseBoolType)
ReferenceEq TypeRepr a
rtp E ext s tp
E ext s ('ReferenceType a)
e1' E ext s tp
E ext s ('ReferenceType a)
e2'
            TypeRepr tp
NatRepr ->
              SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s 'NatType
-> E ext s 'NatType -> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f 'NatType -> f 'NatType -> App ext f ('BaseToType BaseBoolType)
NatEq E ext s tp
E ext s 'NatType
e1' E ext s tp
E ext s 'NatType
e2'
            (TypeRepr tp -> AsBaseType tp
forall (tp :: CrucibleType). TypeRepr tp -> AsBaseType tp
asBaseType -> AsBaseType BaseTypeRepr bt
bt) ->
              SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr bt
-> E ext s (BaseToType bt)
-> E ext s (BaseToType bt)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (tp1 :: BaseType) (f :: CrucibleType -> *) ext.
BaseTypeRepr tp1
-> f (BaseToType tp1)
-> f (BaseToType tp1)
-> App ext f ('BaseToType BaseBoolType)
BaseIsEq BaseTypeRepr bt
bt E ext s tp
E ext s (BaseToType bt)
e1' E ext s tp
E ext s (BaseToType bt)
e2'
            TypeRepr tp
_ ->
              m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"a base type or floating point type or reference type (got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tp) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    compareBV ::
      Keyword ->
      (forall w. (1 <= w) => NatRepr w -> E ext s (BVType w) -> E ext s (BVType w) -> App ext (E ext s) BoolType) ->
      m (SomeExpr ext s)
    compareBV :: Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> m (SomeExpr ext s)
compareBV Keyword
k forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
f =
      do (SomeExpr ext s
e1, SomeExpr ext s
e2) <- Text
-> m (SomeExpr ext s, SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"bitvector compaprison" (m (SomeExpr ext s, SomeExpr ext s)
 -> m (SomeExpr ext s, SomeExpr ext s))
-> m (SomeExpr ext s, SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Keyword
-> m (SomeExpr ext s)
-> m (SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
k m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth' m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth'
         Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a.
Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall (tp :: CrucibleType).
    TypeRepr tp -> E ext s tp -> E ext s tp -> m a)
-> m a
matchingExprs Maybe (Some TypeRepr)
forall a. Maybe a
Nothing SomeExpr ext s
e1 SomeExpr ext s
e2 ((forall {tp :: CrucibleType}.
  TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
tp E ext s tp
e1' E ext s tp
e2' ->
           case TypeRepr tp
tp of
             BVRepr NatRepr n
w ->
               SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
f NatRepr n
w E ext s tp
E ext s ('BaseToType (BaseBVType n))
e1' E ext s tp
E ext s ('BaseToType (BaseBVType n))
e2'
             TypeRepr tp
_ ->
               m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"a bitvector type (got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tp) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    lessThan :: m (SomeExpr ext s)
    lessThan :: m (SomeExpr ext s)
lessThan =
      do (SomeExpr ext s
e1, SomeExpr ext s
e2) <- Text
-> m (SomeExpr ext s, SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"less-than test" (m (SomeExpr ext s, SomeExpr ext s)
 -> m (SomeExpr ext s, SomeExpr ext s))
-> m (SomeExpr ext s, SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Keyword
-> m (SomeExpr ext s)
-> m (SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
Lt m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth' m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth'
         Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a.
Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall (tp :: CrucibleType).
    TypeRepr tp -> E ext s tp -> E ext s tp -> m a)
-> m a
matchingExprs Maybe (Some TypeRepr)
forall a. Maybe a
Nothing SomeExpr ext s
e1 SomeExpr ext s
e2 ((forall {tp :: CrucibleType}.
  TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
tp E ext s tp
e1' E ext s tp
e2' ->
           case TypeRepr tp
tp of
             TypeRepr tp
NatRepr     -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s 'NatType
-> E ext s 'NatType -> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f 'NatType -> f 'NatType -> App ext f ('BaseToType BaseBoolType)
NatLt E ext s tp
E ext s 'NatType
e1' E ext s tp
E ext s 'NatType
e2'
             TypeRepr tp
IntegerRepr -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseIntegerType)
-> f ('BaseToType BaseIntegerType)
-> App ext f ('BaseToType BaseBoolType)
IntLt E ext s tp
E ext s ('BaseToType BaseIntegerType)
e1' E ext s tp
E ext s ('BaseToType BaseIntegerType)
e2'
             TypeRepr tp
RealValRepr -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseRealType)
-> f ('BaseToType BaseRealType)
-> App ext f ('BaseToType BaseBoolType)
RealLt E ext s tp
E ext s ('BaseToType BaseRealType)
e1' E ext s tp
E ext s ('BaseToType BaseRealType)
e2'
             BVRepr NatRepr n
w    -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w
-> f (BVType w)
-> f (BVType w)
-> App ext f ('BaseToType BaseBoolType)
BVUlt NatRepr n
w E ext s tp
E ext s ('BaseToType (BaseBVType n))
e1' E ext s tp
E ext s ('BaseToType (BaseBVType n))
e2'
             TypeRepr tp
other ->
               Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"valid comparison type (got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    lessThanEq :: m (SomeExpr ext s)
    lessThanEq :: m (SomeExpr ext s)
lessThanEq =
      do (SomeExpr ext s
e1, SomeExpr ext s
e2) <- Text
-> m (SomeExpr ext s, SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"less-than-or-equal test" (m (SomeExpr ext s, SomeExpr ext s)
 -> m (SomeExpr ext s, SomeExpr ext s))
-> m (SomeExpr ext s, SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Keyword
-> m (SomeExpr ext s)
-> m (SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
Le m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth' m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (SomeExpr ext s)
synth'
         Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a.
Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall (tp :: CrucibleType).
    TypeRepr tp -> E ext s tp -> E ext s tp -> m a)
-> m a
matchingExprs Maybe (Some TypeRepr)
forall a. Maybe a
Nothing SomeExpr ext s
e1 SomeExpr ext s
e2 ((forall {tp :: CrucibleType}.
  TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
tp E ext s tp
e1' E ext s tp
e2' ->
           case TypeRepr tp
tp of
             TypeRepr tp
NatRepr     -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s 'NatType
-> E ext s 'NatType -> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f 'NatType -> f 'NatType -> App ext f ('BaseToType BaseBoolType)
NatLe E ext s tp
E ext s 'NatType
e1' E ext s tp
E ext s 'NatType
e2'
             TypeRepr tp
IntegerRepr -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseIntegerType)
-> f ('BaseToType BaseIntegerType)
-> App ext f ('BaseToType BaseBoolType)
IntLe E ext s tp
E ext s ('BaseToType BaseIntegerType)
e1' E ext s tp
E ext s ('BaseToType BaseIntegerType)
e2'
             TypeRepr tp
RealValRepr -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseRealType)
-> f ('BaseToType BaseRealType)
-> App ext f ('BaseToType BaseBoolType)
RealLe E ext s tp
E ext s ('BaseToType BaseRealType)
e1' E ext s tp
E ext s ('BaseToType BaseRealType)
e2'
             BVRepr NatRepr n
w    -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w
-> f (BVType w)
-> f (BVType w)
-> App ext f ('BaseToType BaseBoolType)
BVUle NatRepr n
w E ext s tp
E ext s ('BaseToType (BaseBVType n))
e1' E ext s tp
E ext s ('BaseToType (BaseBVType n))
e2'
             TypeRepr tp
other ->
               Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"valid comparison type (got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    naryArith :: Keyword -> m (SomeExpr ext s)
    naryArith :: Keyword -> m (SomeExpr ext s)
naryArith Keyword
k =
      do AST s
ast <- m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
         [SomeExpr ext s]
args <- m () -> m [SomeExpr ext s] -> m [SomeExpr ext s]
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
k) (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
commit m () -> m [SomeExpr ext s] -> m [SomeExpr ext s]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (m (SomeExpr ext s) -> m [SomeExpr ext s]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m [a]
rep (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint)))
         AST s
-> Keyword
-> Maybe (Some TypeRepr)
-> [SomeExpr ext s]
-> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
MonadSyntax Atomic m =>
AST s
-> Keyword
-> Maybe (Some TypeRepr)
-> [SomeExpr ext s]
-> m (SomeExpr ext s)
applyOverloaded AST s
ast Keyword
k Maybe (Some TypeRepr)
typeHint [SomeExpr ext s]
args

    binaryArith :: Keyword -> m (SomeExpr ext s)
    binaryArith :: Keyword -> m (SomeExpr ext s)
binaryArith Keyword
k =
      do AST s
ast <- m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
         (SomeExpr ext s
x, SomeExpr ext s
y) <- Keyword
-> m (SomeExpr ext s)
-> m (SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
k (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint) (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint)
         AST s
-> Keyword
-> Maybe (Some TypeRepr)
-> [SomeExpr ext s]
-> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
MonadSyntax Atomic m =>
AST s
-> Keyword
-> Maybe (Some TypeRepr)
-> [SomeExpr ext s]
-> m (SomeExpr ext s)
applyOverloaded AST s
ast Keyword
k Maybe (Some TypeRepr)
typeHint [SomeExpr ext s
x,SomeExpr ext s
y]

    unaryArith :: Keyword -> m (SomeExpr ext s)
    unaryArith :: Keyword -> m (SomeExpr ext s)
unaryArith Keyword
k =
      do AST s
ast <- m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
         SomeExpr ext s
x <- Keyword -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
k (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint)
         AST s
-> Keyword
-> Maybe (Some TypeRepr)
-> [SomeExpr ext s]
-> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
MonadSyntax Atomic m =>
AST s
-> Keyword
-> Maybe (Some TypeRepr)
-> [SomeExpr ext s]
-> m (SomeExpr ext s)
applyOverloaded AST s
ast Keyword
k Maybe (Some TypeRepr)
typeHint [SomeExpr ext s
x]

    unaryBV ::
      Keyword ->
      (forall w. (1 <= w) => NatRepr w -> E ext s (BVType w) -> App ext (E ext s) BoolType) ->
      m (SomeExpr ext s)
    unaryBV :: Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> App ext (E ext s) ('BaseToType BaseBoolType))
-> m (SomeExpr ext s)
unaryBV Keyword
k forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
f =
      do Pair TypeRepr tp
t E ext s tp
x <- Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
k m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
         case TypeRepr tp
t of
           BVRepr NatRepr n
w ->SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ NatRepr n
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> App ext (E ext s) ('BaseToType BaseBoolType)
f NatRepr n
w E ext s tp
E ext s ('BaseToType (BaseBVType n))
x
           TypeRepr tp
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"bitvector argument" m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    just :: m (SomeExpr ext s)
    just :: m (SomeExpr ext s)
just =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some (MaybeRepr TypeRepr tp1
t)) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr tp1 -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr tp1
t)
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         Pair TypeRepr tp
t E ext s tp
x <- Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Just_ (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint)
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('MaybeType tp)
-> E ext s ('MaybeType tp) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr tp -> TypeRepr ('MaybeType tp)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr TypeRepr tp
t) (E ext s ('MaybeType tp) -> SomeExpr ext s)
-> E ext s ('MaybeType tp) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('MaybeType tp) -> E ext s ('MaybeType tp)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('MaybeType tp) -> E ext s ('MaybeType tp))
-> App ext (E ext s) ('MaybeType tp) -> E ext s ('MaybeType tp)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp -> E ext s tp -> App ext (E ext s) ('MaybeType tp)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1 -> f tp1 -> App ext f ('MaybeType tp1)
JustValue TypeRepr tp
t E ext s tp
x

    nothing :: m (SomeExpr ext s)
    nothing :: m (SomeExpr ext s)
nothing =
      do Some TypeRepr x
t <- Keyword -> m (Some TypeRepr) -> m (Some TypeRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Nothing_ m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('MaybeType x) -> E ext s ('MaybeType x) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr x -> TypeRepr ('MaybeType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr TypeRepr x
t) (E ext s ('MaybeType x) -> SomeExpr ext s)
-> E ext s ('MaybeType x) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('MaybeType x) -> E ext s ('MaybeType x)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('MaybeType x) -> E ext s ('MaybeType x))
-> App ext (E ext s) ('MaybeType x) -> E ext s ('MaybeType x)
forall a b. (a -> b) -> a -> b
$ TypeRepr x -> App ext (E ext s) ('MaybeType x)
forall (tp1 :: CrucibleType) ext (f :: CrucibleType -> *).
TypeRepr tp1 -> App ext f ('MaybeType tp1)
NothingValue TypeRepr x
t
      m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Nothing_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      case Maybe (Some TypeRepr)
typeHint of
        Just (Some (MaybeRepr TypeRepr tp1
t)) ->
          SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('MaybeType tp1)
-> E ext s ('MaybeType tp1) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr TypeRepr tp1
t) (E ext s ('MaybeType tp1) -> SomeExpr ext s)
-> E ext s ('MaybeType tp1) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('MaybeType tp1) -> E ext s ('MaybeType tp1)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('MaybeType tp1) -> E ext s ('MaybeType tp1))
-> App ext (E ext s) ('MaybeType tp1) -> E ext s ('MaybeType tp1)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1 -> App ext (E ext s) ('MaybeType tp1)
forall (tp1 :: CrucibleType) ext (f :: CrucibleType -> *).
TypeRepr tp1 -> App ext f ('MaybeType tp1)
NothingValue TypeRepr tp1
t
        Just (Some TypeRepr x
t) ->
          m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"value of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr x -> String
forall a. Show a => a -> String
show TypeRepr x
t)) m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
        Maybe (Some TypeRepr)
Nothing ->
          m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"unambiguous nothing value") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    fromJust_ :: m (SomeExpr ext s)
    fromJust_ :: m (SomeExpr ext s)
fromJust_ =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some TypeRepr x
t) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr ('MaybeType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr x -> TypeRepr ('MaybeType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr TypeRepr x
t))
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"coercion from Maybe (fromJust-expression)" (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
           m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
FromJust) (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
           m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint) ((Pair TypeRepr (E ext s) -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (Pair TypeRepr (E ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Pair TypeRepr tp
t E ext s tp
e) ->
             case TypeRepr tp
t of
               MaybeRepr TypeRepr tp1
elemT ->
                 m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> (E ext s ('BaseToType (BaseStringType 'Unicode))
    -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr)) ((E ext s ('BaseToType (BaseStringType 'Unicode))
  -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (E ext s ('BaseToType (BaseStringType 'Unicode))
    -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \E ext s ('BaseToType (BaseStringType 'Unicode))
str ->
                   do m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
                      SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1 -> E ext s tp1 -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr tp1
elemT (E ext s tp1 -> SomeExpr ext s) -> E ext s tp1 -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) tp1 -> E ext s tp1
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) tp1 -> E ext s tp1)
-> App ext (E ext s) tp1 -> E ext s tp1
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1
-> E ext s ('MaybeType tp1)
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> App ext (E ext s) tp1
forall (tp :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp
-> f (MaybeType tp)
-> f ('BaseToType (BaseStringType 'Unicode))
-> App ext f tp
FromJustValue TypeRepr tp1
elemT E ext s tp
E ext s ('MaybeType tp1)
e E ext s ('BaseToType (BaseStringType 'Unicode))
str
               TypeRepr tp
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"maybe expression" m (SomeExpr ext s)
nothing

    projection :: m (SomeExpr ext s)
    projection :: m (SomeExpr ext s)
projection =
      do (Integer
n, Pair TypeRepr tp
t E ext s tp
e) <- Text
-> m (Integer, Pair TypeRepr (E ext s))
-> m (Integer, Pair TypeRepr (E ext s))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"projection from variant type" (m (Integer, Pair TypeRepr (E ext s))
 -> m (Integer, Pair TypeRepr (E ext s)))
-> m (Integer, Pair TypeRepr (E ext s))
-> m (Integer, Pair TypeRepr (E ext s))
forall a b. (a -> b) -> a -> b
$ Keyword
-> m Integer
-> m (Pair TypeRepr (E ext s))
-> m (Integer, Pair TypeRepr (E ext s))
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
Proj m Integer
forall (m :: * -> *). MonadSyntax Atomic m => m Integer
int m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
         case TypeRepr tp
t of
           VariantRepr CtxRepr ctx
ts ->
             case Int -> Size ctx -> Maybe (Some (Index ctx))
forall {k} (ctx :: Ctx k).
Int -> Size ctx -> Maybe (Some (Index ctx))
Ctx.intIndex (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (CtxRepr ctx -> Size ctx
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size CtxRepr ctx
ts) of
               Maybe (Some (Index ctx))
Nothing ->
                 Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is an invalid index into " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CtxRepr ctx -> String
forall a. Show a => a -> String
show CtxRepr ctx
ts)) m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
               Just (Some Index ctx x
idx) ->
                 do let ty :: TypeRepr ('MaybeType x)
ty = TypeRepr x -> TypeRepr ('MaybeType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr (CtxRepr ctx
tsCtxRepr ctx
-> Getting (TypeRepr x) (CtxRepr ctx) (TypeRepr x) -> TypeRepr x
forall s a. s -> Getting a s a -> a
^.IndexF (CtxRepr ctx) x
-> Lens' (CtxRepr ctx) (IxValueF (CtxRepr ctx) x)
forall k m (x :: k).
IxedF' k m =>
IndexF m x -> Lens' m (IxValueF m x)
forall (x :: CrucibleType).
IndexF (CtxRepr ctx) x
-> Lens' (CtxRepr ctx) (IxValueF (CtxRepr ctx) x)
ixF' IndexF (CtxRepr ctx) x
Index ctx x
idx)
                    SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('MaybeType x) -> E ext s ('MaybeType x) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('MaybeType x)
ty (E ext s ('MaybeType x) -> SomeExpr ext s)
-> E ext s ('MaybeType x) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('MaybeType x) -> E ext s ('MaybeType x)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('MaybeType x) -> E ext s ('MaybeType x))
-> App ext (E ext s) ('MaybeType x) -> E ext s ('MaybeType x)
forall a b. (a -> b) -> a -> b
$ CtxRepr ctx
-> Index ctx x
-> E ext s ('VariantType ctx)
-> App ext (E ext s) ('MaybeType x)
forall (ctx :: Ctx CrucibleType) (tp1 :: CrucibleType)
       (f :: CrucibleType -> *) ext.
CtxRepr ctx
-> Index ctx tp1
-> f (VariantType ctx)
-> App ext f ('MaybeType tp1)
ProjectVariant CtxRepr ctx
ts Index ctx x
idx E ext s tp
E ext s ('VariantType ctx)
e
           TypeRepr tp
_ -> Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"variant type (got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    injection :: m (SomeExpr ext s)
    injection :: m (SomeExpr ext s)
injection =
      do (Integer
n, AST s
e) <- Text -> m (Integer, AST s) -> m (Integer, AST s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"injection into variant type" (m (Integer, AST s) -> m (Integer, AST s))
-> m (Integer, AST s) -> m (Integer, AST s)
forall a b. (a -> b) -> a -> b
$ Keyword -> m Integer -> m (AST s) -> m (Integer, AST s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
Inj m Integer
forall (m :: * -> *). MonadSyntax Atomic m => m Integer
int m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
         case Maybe (Some TypeRepr)
typeHint of
           Just (Some (VariantRepr CtxRepr ctx
ts)) ->
             case Int -> Size ctx -> Maybe (Some (Index ctx))
forall {k} (ctx :: Ctx k).
Int -> Size ctx -> Maybe (Some (Index ctx))
Ctx.intIndex (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (CtxRepr ctx -> Size ctx
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size CtxRepr ctx
ts) of
               Maybe (Some (Index ctx))
Nothing ->
                 Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is an invalid index into " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CtxRepr ctx -> String
forall a. Show a => a -> String
show CtxRepr ctx
ts)) m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
               Just (Some Index ctx x
idx) ->
                 do let ty :: TypeRepr x
ty = Getting (TypeRepr x) (CtxRepr ctx) (TypeRepr x)
-> CtxRepr ctx -> TypeRepr x
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (IndexF (CtxRepr ctx) x
-> Lens' (CtxRepr ctx) (IxValueF (CtxRepr ctx) x)
forall k m (x :: k).
IxedF' k m =>
IndexF m x -> Lens' m (IxValueF m x)
forall (x :: CrucibleType).
IndexF (CtxRepr ctx) x
-> Lens' (CtxRepr ctx) (IxValueF (CtxRepr ctx) x)
ixF' IndexF (CtxRepr ctx) x
Index ctx x
idx) CtxRepr ctx
ts
                    E ext s x
out <- ProgressStep -> m (E ext s x) -> m (E ext s x)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
ProgressStep -> m a -> m a
withProgressStep ProgressStep
Rest (m (E ext s x) -> m (E ext s x)) -> m (E ext s x) -> m (E ext s x)
forall a b. (a -> b) -> a -> b
$ ProgressStep -> m (E ext s x) -> m (E ext s x)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
ProgressStep -> m a -> m a
withProgressStep ProgressStep
Rest (m (E ext s x) -> m (E ext s x)) -> m (E ext s x) -> m (E ext s x)
forall a b. (a -> b) -> a -> b
$ ProgressStep -> m (E ext s x) -> m (E ext s x)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
ProgressStep -> m a -> m a
withProgressStep ProgressStep
First (m (E ext s x) -> m (E ext s x)) -> m (E ext s x) -> m (E ext s x)
forall a b. (a -> b) -> a -> b
$
                             AST s -> m (E ext s x) -> m (E ext s x)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Syntax atom -> m a -> m a
parse AST s
e (TypeRepr x -> m (E ext s x)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr x
ty)
                    SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('VariantType ctx)
-> E ext s ('VariantType ctx) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (CtxRepr ctx -> TypeRepr ('VariantType ctx)
forall (ctx :: Ctx CrucibleType).
CtxRepr ctx -> TypeRepr ('VariantType ctx)
VariantRepr CtxRepr ctx
ts) (E ext s ('VariantType ctx) -> SomeExpr ext s)
-> E ext s ('VariantType ctx) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('VariantType ctx) -> E ext s ('VariantType ctx)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('VariantType ctx)
 -> E ext s ('VariantType ctx))
-> App ext (E ext s) ('VariantType ctx)
-> E ext s ('VariantType ctx)
forall a b. (a -> b) -> a -> b
$ CtxRepr ctx
-> Index ctx x -> E ext s x -> App ext (E ext s) ('VariantType ctx)
forall (ctx :: Ctx CrucibleType) (tp1 :: CrucibleType)
       (f :: CrucibleType -> *) ext.
CtxRepr ctx
-> Index ctx tp1 -> f tp1 -> App ext f ('VariantType ctx)
InjectVariant CtxRepr ctx
ts Index ctx x
idx E ext s x
out
           Just (Some TypeRepr x
t) ->
             Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"context expecting variant type (got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr x -> String
forall a. Show a => a -> String
show TypeRepr x
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
           Maybe (Some TypeRepr)
Nothing ->
             Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"unambiguous variant") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    fpToBinary :: m (SomeExpr ext s)
    fpToBinary :: m (SomeExpr ext s)
fpToBinary =
       Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
FPToBinary_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
       (m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth ((Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
 -> m (SomeExpr ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Pair TypeRepr tp
tp E ext s tp
x) ->
         case TypeRepr tp
tp of
           FloatRepr FloatInfoRepr flt
fpi
             | BaseBVRepr NatRepr w
w <- FloatInfoRepr flt
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth flt))
forall (fi :: FloatInfo).
FloatInfoRepr fi
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
floatInfoToBVTypeRepr FloatInfoRepr flt
fpi
             , Just LeqProof 1 w
LeqProof <- NatRepr w -> Maybe (LeqProof 1 w)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr w
w ->
                 m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m ()
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. b -> Either a b
Right (SomeExpr ext s -> Either Text (SomeExpr ext s))
-> SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType ('BaseBVType w))
-> E ext s ('BaseToType ('BaseBVType w)) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (NatRepr w -> TypeRepr ('BaseToType ('BaseBVType w))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr w
w) (E ext s ('BaseToType ('BaseBVType w)) -> SomeExpr ext s)
-> E ext s ('BaseToType ('BaseBVType w)) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType ('BaseBVType w))
-> E ext s ('BaseToType ('BaseBVType w))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType ('BaseBVType w))
 -> E ext s ('BaseToType ('BaseBVType w)))
-> App ext (E ext s) ('BaseToType ('BaseBVType w))
-> E ext s ('BaseToType ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr flt
-> E ext s ('FloatType flt)
-> App
     ext (E ext s) ('BaseToType (BaseBVType (FloatInfoToBitWidth flt)))
forall (fi :: FloatInfo) (f :: CrucibleType -> *) ext.
(1 <= FloatInfoToBitWidth fi) =>
FloatInfoRepr fi
-> f (FloatType fi)
-> App ext f ('BaseToType (BaseBVType (FloatInfoToBitWidth fi)))
FloatToBinary FloatInfoRepr flt
fpi E ext s tp
E ext s ('FloatType flt)
x)
           TypeRepr tp
_ -> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s)))
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (SomeExpr ext s)
forall a b. a -> Either a b
Left (Text -> Either Text (SomeExpr ext s))
-> Text -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text
"floating-point value")

    binaryToFp :: m (SomeExpr ext s)
    binaryToFp :: m (SomeExpr ext s)
binaryToFp =
       Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
BinaryToFP_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
       (m (Some FloatInfoRepr)
-> (Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Some FloatInfoRepr)
forall (m :: * -> *).
MonadSyntax Atomic m =>
m (Some FloatInfoRepr)
fpinfo ((Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Some FloatInfoRepr x
fpi) ->
        m (E ext s (BaseToType (BaseBVType (FloatInfoToBitWidth x))))
-> (E ext s (BaseToType (BaseBVType (FloatInfoToBitWidth x)))
    -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (TypeRepr (BaseToType (BaseBVType (FloatInfoToBitWidth x)))
-> m (E ext s (BaseToType (BaseBVType (FloatInfoToBitWidth x))))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth x))
-> TypeRepr (BaseToType (BaseBVType (FloatInfoToBitWidth x)))
forall (bt :: BaseType).
BaseTypeRepr bt -> TypeRepr (BaseToType bt)
baseToType (FloatInfoRepr x
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth x))
forall (fi :: FloatInfo).
FloatInfoRepr fi
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
floatInfoToBVTypeRepr FloatInfoRepr x
fpi))) ((E ext s (BaseToType (BaseBVType (FloatInfoToBitWidth x)))
  -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (E ext s (BaseToType (BaseBVType (FloatInfoToBitWidth x)))
    -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \E ext s (BaseToType (BaseBVType (FloatInfoToBitWidth x)))
x ->
        m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m () -> SomeExpr ext s -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (TypeRepr ('FloatType x) -> E ext s ('FloatType x) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (FloatInfoRepr x -> TypeRepr ('FloatType x)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr x
fpi) (E ext s ('FloatType x) -> SomeExpr ext s)
-> E ext s ('FloatType x) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x))
-> App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr x
-> E ext s (BaseToType (BaseBVType (FloatInfoToBitWidth x)))
-> App ext (E ext s) ('FloatType x)
forall (fi :: FloatInfo) (f :: CrucibleType -> *) ext.
FloatInfoRepr fi
-> f (BVType (FloatInfoToBitWidth fi)) -> App ext f ('FloatType fi)
FloatFromBinary FloatInfoRepr x
fpi E ext s (BaseToType (BaseBVType (FloatInfoToBitWidth x)))
x))

    fpToReal :: m (SomeExpr ext s)
    fpToReal :: m (SomeExpr ext s)
fpToReal =
       Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
FPToReal_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
       (m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth ((Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
 -> m (SomeExpr ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Pair TypeRepr tp
tp E ext s tp
x) ->
         case TypeRepr tp
tp of
           FloatRepr FloatInfoRepr flt
_fpi -> m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m ()
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. b -> Either a b
Right (SomeExpr ext s -> Either Text (SomeExpr ext s))
-> SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseRealType)
RealValRepr (E ext s ('BaseToType BaseRealType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseRealType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseRealType)
 -> E ext s ('BaseToType BaseRealType))
-> App ext (E ext s) ('BaseToType BaseRealType)
-> E ext s ('BaseToType BaseRealType)
forall a b. (a -> b) -> a -> b
$ E ext s ('FloatType flt)
-> App ext (E ext s) ('BaseToType BaseRealType)
forall (f :: CrucibleType -> *) (fi :: FloatInfo) ext.
f (FloatType fi) -> App ext f ('BaseToType BaseRealType)
FloatToReal E ext s tp
E ext s ('FloatType flt)
x)
           TypeRepr tp
_ -> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s)))
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (SomeExpr ext s)
forall a b. a -> Either a b
Left Text
"floating-point value")

    realToFp :: m (SomeExpr ext s)
    realToFp :: m (SomeExpr ext s)
realToFp =
       Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
RealToFP_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
       (m (Some FloatInfoRepr)
-> (Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Some FloatInfoRepr)
forall (m :: * -> *).
MonadSyntax Atomic m =>
m (Some FloatInfoRepr)
fpinfo ((Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Some FloatInfoRepr x
fpi) ->
        m RoundingMode
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m RoundingMode
forall (m :: * -> *). MonadSyntax Atomic m => m RoundingMode
roundingMode ((RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \RoundingMode
rm ->
        m (E ext s ('BaseToType BaseRealType))
-> (E ext s ('BaseToType BaseRealType) -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (TypeRepr ('BaseToType BaseRealType)
-> m (E ext s ('BaseToType BaseRealType))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ('BaseToType BaseRealType)
RealValRepr) ((E ext s ('BaseToType BaseRealType) -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (E ext s ('BaseToType BaseRealType) -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \E ext s ('BaseToType BaseRealType)
x ->
        m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m () -> SomeExpr ext s -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (TypeRepr ('FloatType x) -> E ext s ('FloatType x) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (FloatInfoRepr x -> TypeRepr ('FloatType x)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr x
fpi) (E ext s ('FloatType x) -> SomeExpr ext s)
-> E ext s ('FloatType x) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x))
-> App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr x
-> RoundingMode
-> E ext s ('BaseToType BaseRealType)
-> App ext (E ext s) ('FloatType x)
forall (fi :: FloatInfo) (f :: CrucibleType -> *) ext.
FloatInfoRepr fi
-> RoundingMode
-> f ('BaseToType BaseRealType)
-> App ext f ('FloatType fi)
FloatFromReal FloatInfoRepr x
fpi RoundingMode
rm E ext s ('BaseToType BaseRealType)
x))

    ubvToFloat :: m (SomeExpr ext s)
    ubvToFloat :: m (SomeExpr ext s)
ubvToFloat =
       Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
UBVToFP_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
       (m (Some FloatInfoRepr)
-> (Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Some FloatInfoRepr)
forall (m :: * -> *).
MonadSyntax Atomic m =>
m (Some FloatInfoRepr)
fpinfo ((Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Some FloatInfoRepr x
fpi) ->
        m RoundingMode
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m RoundingMode
forall (m :: * -> *). MonadSyntax Atomic m => m RoundingMode
roundingMode ((RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \RoundingMode
rm ->
        m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth ((Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
 -> m (SomeExpr ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Pair TypeRepr tp
tp E ext s tp
x) ->
          case TypeRepr tp
tp of
            BVRepr NatRepr n
_w ->
              m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m ()
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. b -> Either a b
Right (SomeExpr ext s -> Either Text (SomeExpr ext s))
-> SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('FloatType x) -> E ext s ('FloatType x) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (FloatInfoRepr x -> TypeRepr ('FloatType x)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr x
fpi) (E ext s ('FloatType x) -> SomeExpr ext s)
-> E ext s ('FloatType x) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x))
-> App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr x
-> RoundingMode
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('FloatType x)
forall (w :: Natural) (fi :: FloatInfo) (f :: CrucibleType -> *)
       ext.
(1 <= w) =>
FloatInfoRepr fi
-> RoundingMode -> f (BVType w) -> App ext f ('FloatType fi)
FloatFromBV FloatInfoRepr x
fpi RoundingMode
rm E ext s tp
E ext s ('BaseToType (BaseBVType n))
x)
            TypeRepr tp
_ -> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s)))
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (SomeExpr ext s)
forall a b. a -> Either a b
Left (Text -> Either Text (SomeExpr ext s))
-> Text -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text
"bitvector value"
        )

    sbvToFloat :: m (SomeExpr ext s)
    sbvToFloat :: m (SomeExpr ext s)
sbvToFloat =
       Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
SBVToFP_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
       (m (Some FloatInfoRepr)
-> (Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Some FloatInfoRepr)
forall (m :: * -> *).
MonadSyntax Atomic m =>
m (Some FloatInfoRepr)
fpinfo ((Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (Some FloatInfoRepr -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Some FloatInfoRepr x
fpi) ->
        m RoundingMode
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m RoundingMode
forall (m :: * -> *). MonadSyntax Atomic m => m RoundingMode
roundingMode ((RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \RoundingMode
rm ->
        m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth ((Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
 -> m (SomeExpr ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Pair TypeRepr tp
tp E ext s tp
x) ->
          case TypeRepr tp
tp of
            BVRepr NatRepr n
_w ->
              m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m ()
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. b -> Either a b
Right (SomeExpr ext s -> Either Text (SomeExpr ext s))
-> SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('FloatType x) -> E ext s ('FloatType x) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (FloatInfoRepr x -> TypeRepr ('FloatType x)
forall (flt :: FloatInfo).
FloatInfoRepr flt -> TypeRepr ('FloatType flt)
FloatRepr FloatInfoRepr x
fpi) (E ext s ('FloatType x) -> SomeExpr ext s)
-> E ext s ('FloatType x) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x))
-> App ext (E ext s) ('FloatType x) -> E ext s ('FloatType x)
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr x
-> RoundingMode
-> E ext s ('BaseToType (BaseBVType n))
-> App ext (E ext s) ('FloatType x)
forall (w :: Natural) (fi :: FloatInfo) (f :: CrucibleType -> *)
       ext.
(1 <= w) =>
FloatInfoRepr fi
-> RoundingMode -> f (BVType w) -> App ext f ('FloatType fi)
FloatFromSBV FloatInfoRepr x
fpi RoundingMode
rm E ext s tp
E ext s ('BaseToType (BaseBVType n))
x)
            TypeRepr tp
_ -> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s)))
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (SomeExpr ext s)
forall a b. a -> Either a b
Left (Text -> Either Text (SomeExpr ext s))
-> Text -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text
"bitvector value"
       )

    floatToUBV :: m (SomeExpr ext s)
    floatToUBV :: m (SomeExpr ext s)
floatToUBV =
       Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
FPToUBV_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
       (m PosNat -> (PosNat -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m PosNat
forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat ((PosNat -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (PosNat -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(BoundedNat NatRepr w
w) ->
        m RoundingMode
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m RoundingMode
forall (m :: * -> *). MonadSyntax Atomic m => m RoundingMode
roundingMode ((RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \RoundingMode
rm ->
        m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth ((Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
 -> m (SomeExpr ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Pair TypeRepr tp
tp E ext s tp
x) ->
          case TypeRepr tp
tp of
            FloatRepr FloatInfoRepr flt
_fpi ->
              m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m ()
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. b -> Either a b
Right (SomeExpr ext s -> Either Text (SomeExpr ext s))
-> SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseBVType w))
-> E ext s ('BaseToType (BaseBVType w)) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (NatRepr w -> TypeRepr ('BaseToType (BaseBVType w))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr w
w) (E ext s ('BaseToType (BaseBVType w)) -> SomeExpr ext s)
-> E ext s ('BaseToType (BaseBVType w)) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType (BaseBVType w))
-> E ext s ('BaseToType (BaseBVType w))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType (BaseBVType w))
 -> E ext s ('BaseToType (BaseBVType w)))
-> App ext (E ext s) ('BaseToType (BaseBVType w))
-> E ext s ('BaseToType (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> RoundingMode
-> E ext s ('FloatType flt)
-> App ext (E ext s) ('BaseToType (BaseBVType w))
forall (w :: Natural) (f :: CrucibleType -> *) (fi :: FloatInfo)
       ext.
(1 <= w) =>
NatRepr w
-> RoundingMode
-> f (FloatType fi)
-> App ext f ('BaseToType (BaseBVType w))
FloatToBV NatRepr w
w RoundingMode
rm E ext s tp
E ext s ('FloatType flt)
x)
            TypeRepr tp
_ -> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s)))
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (SomeExpr ext s)
forall a b. a -> Either a b
Left (Text -> Either Text (SomeExpr ext s))
-> Text -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text
"floating-point value")

    floatToSBV :: m (SomeExpr ext s)
    floatToSBV :: m (SomeExpr ext s)
floatToSBV =
       Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
FPToSBV_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
       (m PosNat -> (PosNat -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m PosNat
forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat ((PosNat -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (PosNat -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(BoundedNat NatRepr w
w) ->
        m RoundingMode
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m RoundingMode
forall (m :: * -> *). MonadSyntax Atomic m => m RoundingMode
roundingMode ((RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s))
-> (RoundingMode -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \RoundingMode
rm ->
        m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth ((Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
 -> m (SomeExpr ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \(Pair TypeRepr tp
tp E ext s tp
x) ->
          case TypeRepr tp
tp of
            FloatRepr FloatInfoRepr flt
_fpi ->
              m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m ()
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. b -> Either a b
Right (SomeExpr ext s -> Either Text (SomeExpr ext s))
-> SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseBVType w))
-> E ext s ('BaseToType (BaseBVType w)) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (NatRepr w -> TypeRepr ('BaseToType (BaseBVType w))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr w
w) (E ext s ('BaseToType (BaseBVType w)) -> SomeExpr ext s)
-> E ext s ('BaseToType (BaseBVType w)) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType (BaseBVType w))
-> E ext s ('BaseToType (BaseBVType w))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType (BaseBVType w))
 -> E ext s ('BaseToType (BaseBVType w)))
-> App ext (E ext s) ('BaseToType (BaseBVType w))
-> E ext s ('BaseToType (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> RoundingMode
-> E ext s ('FloatType flt)
-> App ext (E ext s) ('BaseToType (BaseBVType w))
forall (w :: Natural) (f :: CrucibleType -> *) (fi :: FloatInfo)
       ext.
(1 <= w) =>
NatRepr w
-> RoundingMode
-> f (FloatType fi)
-> App ext f ('BaseToType (BaseBVType w))
FloatToSBV NatRepr w
w RoundingMode
rm E ext s tp
E ext s ('FloatType flt)
x)
            TypeRepr tp
_ -> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s)))
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (SomeExpr ext s)
forall a b. a -> Either a b
Left (Text -> Either Text (SomeExpr ext s))
-> Text -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text
"floating-point value")

    ite :: m (SomeExpr ext s)
    ite :: m (SomeExpr ext s)
ite =
      do (E ext s ('BaseToType BaseBoolType)
c, (SomeExpr ext s
et, (SomeExpr ext s
ef, ()))) <-
           m ()
-> m (E ext s ('BaseToType BaseBoolType),
      (SomeExpr ext s, (SomeExpr ext s, ())))
-> m (E ext s ('BaseToType BaseBoolType),
      (SomeExpr ext s, (SomeExpr ext s, ())))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
If) (m (E ext s ('BaseToType BaseBoolType),
    (SomeExpr ext s, (SomeExpr ext s, ())))
 -> m (E ext s ('BaseToType BaseBoolType),
       (SomeExpr ext s, (SomeExpr ext s, ()))))
-> m (E ext s ('BaseToType BaseBoolType),
      (SomeExpr ext s, (SomeExpr ext s, ())))
-> m (E ext s ('BaseToType BaseBoolType),
      (SomeExpr ext s, (SomeExpr ext s, ())))
forall a b. (a -> b) -> a -> b
$
           m (E ext s ('BaseToType BaseBoolType))
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
-> m (E ext s ('BaseToType BaseBoolType),
      (SomeExpr ext s, (SomeExpr ext s, ())))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (TypeRepr ('BaseToType BaseBoolType)
-> m (E ext s ('BaseToType BaseBoolType))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ('BaseToType BaseBoolType)
BoolRepr) (m (SomeExpr ext s, (SomeExpr ext s, ()))
 -> m (E ext s ('BaseToType BaseBoolType),
       (SomeExpr ext s, (SomeExpr ext s, ()))))
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
-> m (E ext s ('BaseToType BaseBoolType),
      (SomeExpr ext s, (SomeExpr ext s, ())))
forall a b. (a -> b) -> a -> b
$
           m (SomeExpr ext s)
-> m (SomeExpr ext s, ())
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint) (m (SomeExpr ext s, ())
 -> m (SomeExpr ext s, (SomeExpr ext s, ())))
-> m (SomeExpr ext s, ())
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
forall a b. (a -> b) -> a -> b
$
           m (SomeExpr ext s) -> m () -> m (SomeExpr ext s, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint) (m () -> m (SomeExpr ext s, ())) -> m () -> m (SomeExpr ext s, ())
forall a b. (a -> b) -> a -> b
$
           m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
         Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a.
Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall (tp :: CrucibleType).
    TypeRepr tp -> E ext s tp -> E ext s tp -> m a)
-> m a
matchingExprs Maybe (Some TypeRepr)
typeHint SomeExpr ext s
et SomeExpr ext s
ef ((forall {tp :: CrucibleType}.
  TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
tp E ext s tp
t E ext s tp
f ->
          case TypeRepr tp
tp of
            FloatRepr FloatInfoRepr flt
fi ->
               SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp -> E ext s tp -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr tp
tp (E ext s tp -> SomeExpr ext s) -> E ext s tp -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) tp -> E ext s tp
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) tp -> E ext s tp)
-> App ext (E ext s) tp -> E ext s tp
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr flt
-> E ext s ('BaseToType BaseBoolType)
-> E ext s ('FloatType flt)
-> E ext s ('FloatType flt)
-> App ext (E ext s) ('FloatType flt)
forall (fi :: FloatInfo) (f :: CrucibleType -> *) ext.
FloatInfoRepr fi
-> f ('BaseToType BaseBoolType)
-> f (FloatType fi)
-> f (FloatType fi)
-> App ext f (FloatType fi)
FloatIte FloatInfoRepr flt
fi E ext s ('BaseToType BaseBoolType)
c E ext s tp
E ext s ('FloatType flt)
t E ext s tp
E ext s ('FloatType flt)
f
            TypeRepr tp
NatRepr ->
               SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp -> E ext s tp -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr tp
tp (E ext s tp -> SomeExpr ext s) -> E ext s tp -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) tp -> E ext s tp
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) tp -> E ext s tp)
-> App ext (E ext s) tp -> E ext s tp
forall a b. (a -> b) -> a -> b
$ E ext s ('BaseToType BaseBoolType)
-> E ext s 'NatType
-> E ext s 'NatType
-> App ext (E ext s) 'NatType
forall (f :: CrucibleType -> *) ext.
f ('BaseToType BaseBoolType)
-> f 'NatType -> f 'NatType -> App ext f 'NatType
NatIte E ext s ('BaseToType BaseBoolType)
c E ext s tp
E ext s 'NatType
t E ext s tp
E ext s 'NatType
f
            (TypeRepr tp -> AsBaseType tp
forall (tp :: CrucibleType). TypeRepr tp -> AsBaseType tp
asBaseType -> AsBaseType BaseTypeRepr bt
bty) ->
               SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp -> E ext s tp -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr tp
tp (E ext s tp -> SomeExpr ext s) -> E ext s tp -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) tp -> E ext s tp
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) tp -> E ext s tp)
-> App ext (E ext s) tp -> E ext s tp
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr bt
-> E ext s ('BaseToType BaseBoolType)
-> E ext s (BaseToType bt)
-> E ext s (BaseToType bt)
-> App ext (E ext s) (BaseToType bt)
forall (tp1 :: BaseType) (f :: CrucibleType -> *) ext.
BaseTypeRepr tp1
-> f ('BaseToType BaseBoolType)
-> f (BaseToType tp1)
-> f (BaseToType tp1)
-> App ext f (BaseToType tp1)
BaseIte BaseTypeRepr bt
bty E ext s ('BaseToType BaseBoolType)
c E ext s tp
E ext s (BaseToType bt)
t E ext s tp
E ext s (BaseToType bt)
f
            TypeRepr tp
_ ->
               let msg :: Text
msg = [Text] -> Text
T.concat [ Text
"conditional where branches have base or floating point type, but got "
                                  , String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tp)
                                  ]
               in m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
msg m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    toAny :: m (SomeExpr ext s)
toAny =
      do Pair TypeRepr tp
tp E ext s tp
e <- Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
ToAny m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr 'AnyType -> E ext s 'AnyType -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr 'AnyType
AnyRepr (App ext (E ext s) 'AnyType -> E ext s 'AnyType
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (TypeRepr tp -> E ext s tp -> App ext (E ext s) 'AnyType
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1 -> f tp1 -> App ext f 'AnyType
PackAny TypeRepr tp
tp E ext s tp
e))
    fromAny :: m (SomeExpr ext s)
fromAny =
      (Keyword
-> m (Some TypeRepr)
-> m (E ext s 'AnyType)
-> m (Some TypeRepr, E ext s 'AnyType)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
FromAny m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType (TypeRepr 'AnyType -> m (E ext s 'AnyType)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr 'AnyType
AnyRepr)) m (Some TypeRepr, E ext s 'AnyType)
-> ((Some TypeRepr, E ext s 'AnyType) -> SomeExpr ext s)
-> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \(Some TypeRepr x
ty, E ext s 'AnyType
e) -> TypeRepr ('MaybeType x) -> E ext s ('MaybeType x) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr x -> TypeRepr ('MaybeType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr TypeRepr x
ty) (App ext (E ext s) ('MaybeType x) -> E ext s ('MaybeType x)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (TypeRepr x -> E ext s 'AnyType -> App ext (E ext s) ('MaybeType x)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1 -> f 'AnyType -> App ext f ('MaybeType tp1)
UnpackAny TypeRepr x
ty E ext s 'AnyType
e))

    stringLength :: m (SomeExpr ext s)
    stringLength :: m (SomeExpr ext s)
stringLength =
      do Keyword -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
StringLength_
           (do (Pair TypeRepr tp
ty E ext s tp
e) <- SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
               case TypeRepr tp
ty of
                 StringRepr StringInfoRepr si
_si -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseIntegerType)
IntegerRepr (E ext s ('BaseToType BaseIntegerType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseIntegerType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (E ext s ('BaseToType (BaseStringType si))
-> App ext (E ext s) ('BaseToType BaseIntegerType)
forall (f :: CrucibleType -> *) (si :: StringInfo) ext.
f (StringType si) -> App ext f ('BaseToType BaseIntegerType)
StringLength E ext s tp
E ext s ('BaseToType (BaseStringType si))
e)
                 TypeRepr tp
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"string expression" m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty)

    stringEmpty :: m (SomeExpr ext s)
stringEmpty =
      Keyword -> m (Some StringInfoRepr) -> m (Some StringInfoRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
StringEmpty_ m (Some StringInfoRepr)
forall (m :: * -> *).
MonadSyntax Atomic m =>
m (Some StringInfoRepr)
stringSort m (Some StringInfoRepr)
-> (Some StringInfoRepr -> SomeExpr ext s) -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Some StringInfoRepr x
si) -> TypeRepr ('BaseToType (BaseStringType x))
-> E ext s ('BaseToType (BaseStringType x)) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (StringInfoRepr x -> TypeRepr ('BaseToType (BaseStringType x))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr x
si) (E ext s ('BaseToType (BaseStringType x)) -> SomeExpr ext s)
-> E ext s ('BaseToType (BaseStringType x)) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType (BaseStringType x))
-> E ext s ('BaseToType (BaseStringType x))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType (BaseStringType x))
 -> E ext s ('BaseToType (BaseStringType x)))
-> App ext (E ext s) ('BaseToType (BaseStringType x))
-> E ext s ('BaseToType (BaseStringType x))
forall a b. (a -> b) -> a -> b
$ StringInfoRepr x
-> App ext (E ext s) ('BaseToType (BaseStringType x))
forall (si :: StringInfo) ext (f :: CrucibleType -> *).
StringInfoRepr si -> App ext f ('BaseToType (BaseStringType si))
StringEmpty StringInfoRepr x
si

    stringAppend :: m (SomeExpr ext s)
    stringAppend :: m (SomeExpr ext s)
stringAppend =
      do (SomeExpr ext s
e1,(SomeExpr ext s
e2,())) <-
           m ()
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
StringConcat_) (m (SomeExpr ext s, (SomeExpr ext s, ()))
 -> m (SomeExpr ext s, (SomeExpr ext s, ())))
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
forall a b. (a -> b) -> a -> b
$
           m (SomeExpr ext s)
-> m (SomeExpr ext s, ())
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint) (m (SomeExpr ext s, ())
 -> m (SomeExpr ext s, (SomeExpr ext s, ())))
-> m (SomeExpr ext s, ())
-> m (SomeExpr ext s, (SomeExpr ext s, ()))
forall a b. (a -> b) -> a -> b
$
           m (SomeExpr ext s) -> m () -> m (SomeExpr ext s, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint) (m () -> m (SomeExpr ext s, ())) -> m () -> m (SomeExpr ext s, ())
forall a b. (a -> b) -> a -> b
$
           m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
         Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a.
Maybe (Some TypeRepr)
-> SomeExpr ext s
-> SomeExpr ext s
-> (forall (tp :: CrucibleType).
    TypeRepr tp -> E ext s tp -> E ext s tp -> m a)
-> m a
matchingExprs Maybe (Some TypeRepr)
typeHint SomeExpr ext s
e1 SomeExpr ext s
e2 ((forall {tp :: CrucibleType}.
  TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (forall {tp :: CrucibleType}.
    TypeRepr tp -> E ext s tp -> E ext s tp -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ \TypeRepr tp
tp E ext s tp
s1 E ext s tp
s2 ->
           case TypeRepr tp
tp of
             StringRepr StringInfoRepr si
si -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseStringType si))
-> E ext s ('BaseToType (BaseStringType si)) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr si
si) (E ext s ('BaseToType (BaseStringType si)) -> SomeExpr ext s)
-> E ext s ('BaseToType (BaseStringType si)) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType (BaseStringType si))
-> E ext s ('BaseToType (BaseStringType si))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType (BaseStringType si))
 -> E ext s ('BaseToType (BaseStringType si)))
-> App ext (E ext s) ('BaseToType (BaseStringType si))
-> E ext s ('BaseToType (BaseStringType si))
forall a b. (a -> b) -> a -> b
$ StringInfoRepr si
-> E ext s ('BaseToType (BaseStringType si))
-> E ext s ('BaseToType (BaseStringType si))
-> App ext (E ext s) ('BaseToType (BaseStringType si))
forall (si :: StringInfo) (f :: CrucibleType -> *) ext.
StringInfoRepr si
-> f (StringType si)
-> f (StringType si)
-> App ext f (StringType si)
StringConcat StringInfoRepr si
si E ext s tp
E ext s ('BaseToType (BaseStringType si))
s1 E ext s tp
E ext s ('BaseToType (BaseStringType si))
s2
             TypeRepr tp
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"string expressions" m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    vecRep :: m (SomeExpr ext s)
    vecRep :: m (SomeExpr ext s)
vecRep =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some (VectorRepr TypeRepr tp1
t)) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr tp1 -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr tp1
t)
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         (E ext s 'NatType
n, Pair TypeRepr tp
t E ext s tp
e) <-
           Keyword
-> m (E ext s 'NatType)
-> m (Pair TypeRepr (E ext s))
-> m (E ext s 'NatType, Pair TypeRepr (E ext s))
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
VectorReplicate_ (TypeRepr 'NatType -> m (E ext s 'NatType)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr 'NatType
NatRepr) (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint)
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('VectorType tp)
-> E ext s ('VectorType tp) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr tp -> TypeRepr ('VectorType tp)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr tp
t) (E ext s ('VectorType tp) -> SomeExpr ext s)
-> E ext s ('VectorType tp) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('VectorType tp) -> E ext s ('VectorType tp)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('VectorType tp) -> E ext s ('VectorType tp))
-> App ext (E ext s) ('VectorType tp) -> E ext s ('VectorType tp)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp
-> E ext s 'NatType
-> E ext s tp
-> App ext (E ext s) ('VectorType tp)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1 -> f 'NatType -> f tp1 -> App ext f ('VectorType tp1)
VectorReplicate TypeRepr tp
t E ext s 'NatType
n E ext s tp
e

    vecLen :: m (SomeExpr ext s)
    vecLen :: m (SomeExpr ext s)
vecLen =
      do Pair TypeRepr tp
t E ext s tp
e <- Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
VectorSize_ m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
         case TypeRepr tp
t of
           VectorRepr TypeRepr tp1
_ -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr 'NatType -> E ext s 'NatType -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr 'NatType
NatRepr (E ext s 'NatType -> SomeExpr ext s)
-> E ext s 'NatType -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) 'NatType -> E ext s 'NatType
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) 'NatType -> E ext s 'NatType)
-> App ext (E ext s) 'NatType -> E ext s 'NatType
forall a b. (a -> b) -> a -> b
$ E ext s ('VectorType tp1) -> App ext (E ext s) 'NatType
forall (f :: CrucibleType -> *) (tp1 :: CrucibleType) ext.
f (VectorType tp1) -> App ext f 'NatType
VectorSize E ext s tp
E ext s ('VectorType tp1)
e
           TypeRepr tp
other -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"vector (found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    vecEmptyP :: m (SomeExpr ext s)
    vecEmptyP :: m (SomeExpr ext s)
vecEmptyP =
      do Pair TypeRepr tp
t E ext s tp
e <- Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
VectorIsEmpty_ m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
         case TypeRepr tp
t of
           VectorRepr TypeRepr tp1
_ -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ E ext s ('VectorType tp1)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (f :: CrucibleType -> *) (tp1 :: CrucibleType) ext.
f (VectorType tp1) -> App ext f ('BaseToType BaseBoolType)
VectorIsEmpty E ext s tp
E ext s ('VectorType tp1)
e
           TypeRepr tp
other -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"vector (found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    vecLit :: m (SomeExpr ext s)
    vecLit :: m (SomeExpr ext s)
vecLit =
      let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                       Just (Some (VectorRepr TypeRepr tp1
t)) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr tp1 -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr tp1
t)
                       Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
       in Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"vector literal" (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
          do ((),[SomeExpr ext s]
ls) <- m () -> m [SomeExpr ext s] -> m ((), [SomeExpr ext s])
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
VectorLit_) (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
commit m () -> m [SomeExpr ext s] -> m [SomeExpr ext s]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (SomeExpr ext s) -> m [SomeExpr ext s]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m [a]
rep (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint))
             case Maybe (Some TypeRepr) -> [SomeExpr ext s] -> Maybe (Some TypeRepr)
forall ext s.
Maybe (Some TypeRepr) -> [SomeExpr ext s] -> Maybe (Some TypeRepr)
findJointType Maybe (Some TypeRepr)
newhint [SomeExpr ext s]
ls of
               Maybe (Some TypeRepr)
Nothing -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"unambiguous vector literal (add a type ascription to disambiguate)" m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
               Just (Some TypeRepr x
t) ->
                 TypeRepr ('VectorType x)
-> E ext s ('VectorType x) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr x -> TypeRepr ('VectorType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr x
t) (E ext s ('VectorType x) -> SomeExpr ext s)
-> ([E ext s x] -> E ext s ('VectorType x))
-> [E ext s x]
-> SomeExpr ext s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App ext (E ext s) ('VectorType x) -> E ext s ('VectorType x)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('VectorType x) -> E ext s ('VectorType x))
-> ([E ext s x] -> App ext (E ext s) ('VectorType x))
-> [E ext s x]
-> E ext s ('VectorType x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRepr x
-> Vector (E ext s x) -> App ext (E ext s) ('VectorType x)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1 -> Vector (f tp1) -> App ext f ('VectorType tp1)
VectorLit TypeRepr x
t (Vector (E ext s x) -> App ext (E ext s) ('VectorType x))
-> ([E ext s x] -> Vector (E ext s x))
-> [E ext s x]
-> App ext (E ext s) ('VectorType x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [E ext s x] -> Vector (E ext s x)
forall a. [a] -> Vector a
V.fromList
                   ([E ext s x] -> SomeExpr ext s)
-> m [E ext s x] -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeExpr ext s -> m (E ext s x))
-> [SomeExpr ext s] -> m [E ext s x]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TypeRepr x -> SomeExpr ext s -> m (E ext s x)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr x
t) [SomeExpr ext s]
ls

    vecCons :: m (SomeExpr ext s)
    vecCons :: m (SomeExpr ext s)
vecCons =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some (VectorRepr TypeRepr tp1
t)) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr tp1 -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr tp1
t)
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         (SomeExpr ext s
a, SomeExpr ext s
d) <- Keyword
-> m (SomeExpr ext s)
-> m (SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
VectorCons_ (m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint)) (m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint))
         let g :: Maybe (Some TypeRepr) -> Maybe (Some TypeRepr)
g Maybe (Some TypeRepr)
Nothing = Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
             g (Just (Some TypeRepr x
t)) = Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr ('VectorType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr x -> TypeRepr ('VectorType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr x
t))
         case Maybe (Maybe (Some TypeRepr)) -> Maybe (Some TypeRepr)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((Maybe (Some TypeRepr) -> Bool)
-> [Maybe (Some TypeRepr)] -> Maybe (Maybe (Some TypeRepr))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Maybe (Some TypeRepr) -> Bool
forall a. Maybe a -> Bool
isJust [ Maybe (Some TypeRepr)
typeHint, Maybe (Some TypeRepr) -> Maybe (Some TypeRepr)
g (SomeExpr ext s -> Maybe (Some TypeRepr)
forall ext s. SomeExpr ext s -> Maybe (Some TypeRepr)
someExprType SomeExpr ext s
a), SomeExpr ext s -> Maybe (Some TypeRepr)
forall ext s. SomeExpr ext s -> Maybe (Some TypeRepr)
someExprType SomeExpr ext s
d ]) of
           Just (Some (VectorRepr TypeRepr tp1
t)) ->
             TypeRepr ('VectorType tp1)
-> E ext s ('VectorType tp1) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr tp1 -> TypeRepr ('VectorType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr tp1
t) (E ext s ('VectorType tp1) -> SomeExpr ext s)
-> (App ext (E ext s) ('VectorType tp1)
    -> E ext s ('VectorType tp1))
-> App ext (E ext s) ('VectorType tp1)
-> SomeExpr ext s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App ext (E ext s) ('VectorType tp1) -> E ext s ('VectorType tp1)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('VectorType tp1) -> SomeExpr ext s)
-> m (App ext (E ext s) ('VectorType tp1)) -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeRepr tp1
-> E ext s tp1
-> E ext s ('VectorType tp1)
-> App ext (E ext s) ('VectorType tp1)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1
-> f tp1 -> f (VectorType tp1) -> App ext f (VectorType tp1)
VectorCons TypeRepr tp1
t (E ext s tp1
 -> E ext s ('VectorType tp1)
 -> App ext (E ext s) ('VectorType tp1))
-> m (E ext s tp1)
-> m (E ext s ('VectorType tp1)
      -> App ext (E ext s) ('VectorType tp1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRepr tp1 -> SomeExpr ext s -> m (E ext s tp1)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr tp1
t SomeExpr ext s
a m (E ext s ('VectorType tp1)
   -> App ext (E ext s) ('VectorType tp1))
-> m (E ext s ('VectorType tp1))
-> m (App ext (E ext s) ('VectorType tp1))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeRepr ('VectorType tp1)
-> SomeExpr ext s -> m (E ext s ('VectorType tp1))
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr (TypeRepr tp1 -> TypeRepr ('VectorType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr tp1
t) SomeExpr ext s
d)
           Maybe (Some TypeRepr)
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"unambiguous vector cons (add a type ascription to disambiguate)" m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    vecGet :: m (SomeExpr ext s)
    vecGet :: m (SomeExpr ext s)
vecGet =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some TypeRepr x
t) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr ('VectorType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr x -> TypeRepr ('VectorType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr x
t))
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         (Pair TypeRepr tp
t E ext s tp
e, E ext s 'NatType
n) <-
            Keyword
-> m (Pair TypeRepr (E ext s))
-> m (E ext s 'NatType)
-> m (Pair TypeRepr (E ext s), E ext s 'NatType)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
VectorGetEntry_ (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint) (TypeRepr 'NatType -> m (E ext s 'NatType)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr 'NatType
NatRepr)
         case TypeRepr tp
t of
           VectorRepr TypeRepr tp1
elemT -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1 -> E ext s tp1 -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr tp1
elemT (E ext s tp1 -> SomeExpr ext s) -> E ext s tp1 -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) tp1 -> E ext s tp1
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) tp1 -> E ext s tp1)
-> App ext (E ext s) tp1 -> E ext s tp1
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1
-> E ext s ('VectorType tp1)
-> E ext s 'NatType
-> App ext (E ext s) tp1
forall (tp :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp -> f (VectorType tp) -> f 'NatType -> App ext f tp
VectorGetEntry TypeRepr tp1
elemT E ext s tp
E ext s ('VectorType tp1)
e E ext s 'NatType
n
           TypeRepr tp
other -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"vector (found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    vecSet :: m (SomeExpr ext s)
    vecSet :: m (SomeExpr ext s)
vecSet =
      do (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
VectorSetEntry_) m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy` (
           m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint) ((Pair TypeRepr (E ext s) -> m (SomeExpr ext s))
 -> m (SomeExpr ext s))
-> (Pair TypeRepr (E ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
            \ (Pair TypeRepr tp
t E ext s tp
vec) ->
              case TypeRepr tp
t of
                VectorRepr TypeRepr tp1
elemT ->
                  do (E ext s 'NatType
n, (E ext s tp1
elt, ())) <- m (E ext s 'NatType)
-> m (E ext s tp1, ()) -> m (E ext s 'NatType, (E ext s tp1, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (TypeRepr 'NatType -> m (E ext s 'NatType)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr 'NatType
NatRepr) (m (E ext s tp1, ()) -> m (E ext s 'NatType, (E ext s tp1, ())))
-> m (E ext s tp1, ()) -> m (E ext s 'NatType, (E ext s tp1, ()))
forall a b. (a -> b) -> a -> b
$
                                       m (E ext s tp1) -> m () -> m (E ext s tp1, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (TypeRepr tp1 -> m (E ext s tp1)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr tp1
elemT) (m () -> m (E ext s tp1, ())) -> m () -> m (E ext s tp1, ())
forall a b. (a -> b) -> a -> b
$
                                       m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
                     SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('VectorType tp1)
-> E ext s ('VectorType tp1) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr tp1 -> TypeRepr ('VectorType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('VectorType tp1)
VectorRepr TypeRepr tp1
elemT) (E ext s ('VectorType tp1) -> SomeExpr ext s)
-> E ext s ('VectorType tp1) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('VectorType tp1) -> E ext s ('VectorType tp1)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('VectorType tp1) -> E ext s ('VectorType tp1))
-> App ext (E ext s) ('VectorType tp1) -> E ext s ('VectorType tp1)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1
-> E ext s ('VectorType tp1)
-> E ext s 'NatType
-> E ext s tp1
-> App ext (E ext s) ('VectorType tp1)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1
-> f (VectorType tp1)
-> f 'NatType
-> f tp1
-> App ext f (VectorType tp1)
VectorSetEntry TypeRepr tp1
elemT E ext s tp
E ext s ('VectorType tp1)
vec E ext s 'NatType
n E ext s tp1
elt
                TypeRepr tp
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"argument with vector type" m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty)

    struct :: m (SomeExpr ext s)
    struct :: m (SomeExpr ext s)
struct = Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"struct literal" (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
MkStruct_) (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
commit m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      do [Pair TypeRepr (E ext s)]
ls <- case Maybe (Some TypeRepr)
typeHint of
                  Just (Some (StructRepr CtxRepr ctx
ctx)) ->
                     [m (Pair TypeRepr (E ext s))] -> m [Pair TypeRepr (E ext s)]
forall atom (m :: * -> *) a. MonadSyntax atom m => [m a] -> m [a]
list ((forall (x :: CrucibleType).
 TypeRepr x -> m (Pair TypeRepr (E ext s)))
-> forall (x :: Ctx CrucibleType).
   Assignment TypeRepr x -> [m (Pair TypeRepr (E ext s))]
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
forall (f :: CrucibleType -> *) a.
(forall (x :: CrucibleType). f x -> a)
-> forall (x :: Ctx CrucibleType). Assignment f x -> [a]
toListFC (\TypeRepr x
t -> SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr (Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr x -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr x
t))) CtxRepr ctx
ctx)
                  Just (Some TypeRepr x
t) -> m [Pair TypeRepr (E ext s)] -> m [Pair TypeRepr (E ext s)]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m [Pair TypeRepr (E ext s)] -> m [Pair TypeRepr (E ext s)])
-> m [Pair TypeRepr (E ext s)] -> m [Pair TypeRepr (E ext s)]
forall a b. (a -> b) -> a -> b
$ Text -> m [Pair TypeRepr (E ext s)] -> m [Pair TypeRepr (E ext s)]
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"value of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr x -> String
forall a. Show a => a -> String
show TypeRepr x
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got struct") m [Pair TypeRepr (E ext s)]
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
                  Maybe (Some TypeRepr)
Nothing -> m (Pair TypeRepr (E ext s)) -> m [Pair TypeRepr (E ext s)]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m [a]
rep (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
forall a. Maybe a
Nothing)
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$! [Pair TypeRepr (E ext s)] -> SomeExpr ext s
forall ext s. [Pair TypeRepr (E ext s)] -> SomeExpr ext s
buildStruct [Pair TypeRepr (E ext s)]
ls)

    getField :: m (SomeExpr ext s)
    getField :: m (SomeExpr ext s)
getField =
      Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"struct field projection" (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
      m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
GetField_) (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
commit m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      m Integer -> (Integer -> m (SomeExpr ext s)) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m Integer
forall (m :: * -> *). MonadSyntax Atomic m => m Integer
int (\Integer
n ->
      m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth (\(Pair TypeRepr tp
t E ext s tp
e) ->
         case TypeRepr tp
t of
           StructRepr CtxRepr ctx
ts ->
             case Int -> Size ctx -> Maybe (Some (Index ctx))
forall {k} (ctx :: Ctx k).
Int -> Size ctx -> Maybe (Some (Index ctx))
Ctx.intIndex (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (CtxRepr ctx -> Size ctx
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size CtxRepr ctx
ts) of
               Maybe (Some (Index ctx))
Nothing ->
                 Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is an invalid index into " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CtxRepr ctx -> String
forall a. Show a => a -> String
show CtxRepr ctx
ts)) m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
               Just (Some Index ctx x
idx) ->
                 do let ty :: TypeRepr x
ty = CtxRepr ctx
tsCtxRepr ctx
-> Getting (TypeRepr x) (CtxRepr ctx) (TypeRepr x) -> TypeRepr x
forall s a. s -> Getting a s a -> a
^.IndexF (CtxRepr ctx) x
-> Lens' (CtxRepr ctx) (IxValueF (CtxRepr ctx) x)
forall k m (x :: k).
IxedF' k m =>
IndexF m x -> Lens' m (IxValueF m x)
forall (x :: CrucibleType).
IndexF (CtxRepr ctx) x
-> Lens' (CtxRepr ctx) (IxValueF (CtxRepr ctx) x)
ixF' IndexF (CtxRepr ctx) x
Index ctx x
idx
                    SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr x -> E ext s x -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr x
ty (E ext s x -> SomeExpr ext s) -> E ext s x -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) x -> E ext s x
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) x -> E ext s x)
-> App ext (E ext s) x -> E ext s x
forall a b. (a -> b) -> a -> b
$ E ext s ('StructType ctx)
-> Index ctx x -> TypeRepr x -> App ext (E ext s) x
forall (f :: CrucibleType -> *) (ctx :: Ctx CrucibleType)
       (tp :: CrucibleType) ext.
f (StructType ctx) -> Index ctx tp -> TypeRepr tp -> App ext f tp
GetStruct E ext s tp
E ext s ('StructType ctx)
e Index ctx x
idx TypeRepr x
ty
           TypeRepr tp
_ -> Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"struct type (got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty)))

    setField :: m (SomeExpr ext s)
    setField :: m (SomeExpr ext s)
setField = Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"update to a struct type" (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$
      m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
SetField_) (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
commit m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint) (\ (Pair TypeRepr tp
tp E ext s tp
e) ->
        case TypeRepr tp
tp of
          StructRepr CtxRepr ctx
ts -> SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. b -> Either a b
Right (SomeExpr ext s -> Either Text (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            m Integer
-> (Integer -> m (Either Text (SomeExpr ext s)))
-> m (SomeExpr ext s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m Integer
forall (m :: * -> *). MonadSyntax Atomic m => m Integer
int (\Integer
n ->
              case Int -> Size ctx -> Maybe (Some (Index ctx))
forall {k} (ctx :: Ctx k).
Int -> Size ctx -> Maybe (Some (Index ctx))
Ctx.intIndex (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (CtxRepr ctx -> Size ctx
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size CtxRepr ctx
ts) of
                Maybe (Some (Index ctx))
Nothing -> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Either Text (SomeExpr ext s)
forall a b. a -> Either a b
Left (String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is an invalid index into " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CtxRepr ctx -> String
forall a. Show a => a -> String
show CtxRepr ctx
ts)))
                Just (Some Index ctx x
idx) -> SomeExpr ext s -> Either Text (SomeExpr ext s)
forall a b. b -> Either a b
Right (SomeExpr ext s -> Either Text (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  do let ty :: TypeRepr x
ty = CtxRepr ctx
tsCtxRepr ctx
-> Getting (TypeRepr x) (CtxRepr ctx) (TypeRepr x) -> TypeRepr x
forall s a. s -> Getting a s a -> a
^.IndexF (CtxRepr ctx) x
-> Lens' (CtxRepr ctx) (IxValueF (CtxRepr ctx) x)
forall k m (x :: k).
IxedF' k m =>
IndexF m x -> Lens' m (IxValueF m x)
forall (x :: CrucibleType).
IndexF (CtxRepr ctx) x
-> Lens' (CtxRepr ctx) (IxValueF (CtxRepr ctx) x)
ixF' IndexF (CtxRepr ctx) x
Index ctx x
idx
                     (E ext s x
v,()) <- m (E ext s x) -> m () -> m (E ext s x, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (TypeRepr x -> m (E ext s x)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr x
ty) m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
                     SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('StructType ctx)
-> E ext s ('StructType ctx) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (CtxRepr ctx -> TypeRepr ('StructType ctx)
forall (ctx :: Ctx CrucibleType).
CtxRepr ctx -> TypeRepr ('StructType ctx)
StructRepr CtxRepr ctx
ts) (E ext s ('StructType ctx) -> SomeExpr ext s)
-> E ext s ('StructType ctx) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('StructType ctx) -> E ext s ('StructType ctx)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('StructType ctx) -> E ext s ('StructType ctx))
-> App ext (E ext s) ('StructType ctx) -> E ext s ('StructType ctx)
forall a b. (a -> b) -> a -> b
$ CtxRepr ctx
-> E ext s ('StructType ctx)
-> Index ctx x
-> E ext s x
-> App ext (E ext s) ('StructType ctx)
forall (ctx :: Ctx CrucibleType) (f :: CrucibleType -> *)
       (tp1 :: CrucibleType) ext.
CtxRepr ctx
-> f (StructType ctx)
-> Index ctx tp1
-> f tp1
-> App ext f (StructType ctx)
SetStruct CtxRepr ctx
ts E ext s tp
E ext s ('StructType ctx)
e Index ctx x
idx E ext s x
v)
          TypeRepr tp
_ -> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s)))
-> Either Text (SomeExpr ext s) -> m (Either Text (SomeExpr ext s))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (SomeExpr ext s)
forall a b. a -> Either a b
Left (Text -> Either Text (SomeExpr ext s))
-> Text -> Either Text (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ (Text
"struct type, but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
tp))))

    seqNil :: m (SomeExpr ext s)
    seqNil :: m (SomeExpr ext s)
seqNil =
      do Some TypeRepr x
t <- Keyword -> m (Some TypeRepr) -> m (Some TypeRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
SequenceNil_ m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType
         SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('SequenceType x)
-> E ext s ('SequenceType x) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr x -> TypeRepr ('SequenceType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr x
t) (E ext s ('SequenceType x) -> SomeExpr ext s)
-> E ext s ('SequenceType x) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('SequenceType x) -> E ext s ('SequenceType x)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('SequenceType x) -> E ext s ('SequenceType x))
-> App ext (E ext s) ('SequenceType x) -> E ext s ('SequenceType x)
forall a b. (a -> b) -> a -> b
$ TypeRepr x -> App ext (E ext s) ('SequenceType x)
forall (tp1 :: CrucibleType) ext (f :: CrucibleType -> *).
TypeRepr tp1 -> App ext f ('SequenceType tp1)
SequenceNil TypeRepr x
t
      m (SomeExpr ext s) -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
SequenceNil_ m () -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      case Maybe (Some TypeRepr)
typeHint of
        Just (Some (SequenceRepr TypeRepr tp1
t)) ->
          SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('SequenceType tp1)
-> E ext s ('SequenceType tp1) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp1
t) (E ext s ('SequenceType tp1) -> SomeExpr ext s)
-> E ext s ('SequenceType tp1) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('SequenceType tp1)
-> E ext s ('SequenceType tp1)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('SequenceType tp1)
 -> E ext s ('SequenceType tp1))
-> App ext (E ext s) ('SequenceType tp1)
-> E ext s ('SequenceType tp1)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1 -> App ext (E ext s) ('SequenceType tp1)
forall (tp1 :: CrucibleType) ext (f :: CrucibleType -> *).
TypeRepr tp1 -> App ext f ('SequenceType tp1)
SequenceNil TypeRepr tp1
t
        Just (Some TypeRepr x
t) ->
          m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"value of type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr x -> String
forall a. Show a => a -> String
show TypeRepr x
t)) m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
        Maybe (Some TypeRepr)
Nothing ->
          m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"unambiguous nil value") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    seqCons :: m (SomeExpr ext s)
    seqCons :: m (SomeExpr ext s)
seqCons =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some (SequenceRepr TypeRepr tp1
t)) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr tp1 -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr tp1
t)
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         (SomeExpr ext s
a, SomeExpr ext s
d) <- Keyword
-> m (SomeExpr ext s)
-> m (SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
SequenceCons_ (m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint)) (m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint))
         let g :: Maybe (Some TypeRepr) -> Maybe (Some TypeRepr)
g Maybe (Some TypeRepr)
Nothing = Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
             g (Just (Some TypeRepr x
t)) = Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr ('SequenceType x) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr x -> TypeRepr ('SequenceType x)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr x
t))
         case Maybe (Maybe (Some TypeRepr)) -> Maybe (Some TypeRepr)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((Maybe (Some TypeRepr) -> Bool)
-> [Maybe (Some TypeRepr)] -> Maybe (Maybe (Some TypeRepr))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Maybe (Some TypeRepr) -> Bool
forall a. Maybe a -> Bool
isJust [ Maybe (Some TypeRepr)
typeHint, Maybe (Some TypeRepr) -> Maybe (Some TypeRepr)
g (SomeExpr ext s -> Maybe (Some TypeRepr)
forall ext s. SomeExpr ext s -> Maybe (Some TypeRepr)
someExprType SomeExpr ext s
a), SomeExpr ext s -> Maybe (Some TypeRepr)
forall ext s. SomeExpr ext s -> Maybe (Some TypeRepr)
someExprType SomeExpr ext s
d ]) of
           Just (Some (SequenceRepr TypeRepr tp1
t)) ->
             TypeRepr ('SequenceType tp1)
-> E ext s ('SequenceType tp1) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp1
t) (E ext s ('SequenceType tp1) -> SomeExpr ext s)
-> (App ext (E ext s) ('SequenceType tp1)
    -> E ext s ('SequenceType tp1))
-> App ext (E ext s) ('SequenceType tp1)
-> SomeExpr ext s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App ext (E ext s) ('SequenceType tp1)
-> E ext s ('SequenceType tp1)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('SequenceType tp1) -> SomeExpr ext s)
-> m (App ext (E ext s) ('SequenceType tp1)) -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeRepr tp1
-> E ext s tp1
-> E ext s ('SequenceType tp1)
-> App ext (E ext s) ('SequenceType tp1)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1
-> f tp1 -> f (SequenceType tp1) -> App ext f (SequenceType tp1)
SequenceCons TypeRepr tp1
t (E ext s tp1
 -> E ext s ('SequenceType tp1)
 -> App ext (E ext s) ('SequenceType tp1))
-> m (E ext s tp1)
-> m (E ext s ('SequenceType tp1)
      -> App ext (E ext s) ('SequenceType tp1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRepr tp1 -> SomeExpr ext s -> m (E ext s tp1)
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr TypeRepr tp1
t SomeExpr ext s
a m (E ext s ('SequenceType tp1)
   -> App ext (E ext s) ('SequenceType tp1))
-> m (E ext s ('SequenceType tp1))
-> m (App ext (E ext s) ('SequenceType tp1))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeRepr ('SequenceType tp1)
-> SomeExpr ext s -> m (E ext s ('SequenceType tp1))
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr (TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp1
t) SomeExpr ext s
d)
           Maybe (Some TypeRepr)
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"unambiguous sequence cons (add a type ascription to disambiguate)" m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    seqAppend :: m (SomeExpr ext s)
    seqAppend :: m (SomeExpr ext s)
seqAppend =
      do (SomeExpr ext s
x, SomeExpr ext s
y) <- Keyword
-> m (SomeExpr ext s)
-> m (SomeExpr ext s)
-> m (SomeExpr ext s, SomeExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
SequenceAppend_ (m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint)) (m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
typeHint))
         case Maybe (Maybe (Some TypeRepr)) -> Maybe (Some TypeRepr)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((Maybe (Some TypeRepr) -> Bool)
-> [Maybe (Some TypeRepr)] -> Maybe (Maybe (Some TypeRepr))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Maybe (Some TypeRepr) -> Bool
forall a. Maybe a -> Bool
isJust [ Maybe (Some TypeRepr)
typeHint, SomeExpr ext s -> Maybe (Some TypeRepr)
forall ext s. SomeExpr ext s -> Maybe (Some TypeRepr)
someExprType SomeExpr ext s
x, SomeExpr ext s -> Maybe (Some TypeRepr)
forall ext s. SomeExpr ext s -> Maybe (Some TypeRepr)
someExprType SomeExpr ext s
y ]) of
           Just (Some (SequenceRepr TypeRepr tp1
t)) ->
             TypeRepr ('SequenceType tp1)
-> E ext s ('SequenceType tp1) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp1
t) (E ext s ('SequenceType tp1) -> SomeExpr ext s)
-> (App ext (E ext s) ('SequenceType tp1)
    -> E ext s ('SequenceType tp1))
-> App ext (E ext s) ('SequenceType tp1)
-> SomeExpr ext s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App ext (E ext s) ('SequenceType tp1)
-> E ext s ('SequenceType tp1)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('SequenceType tp1) -> SomeExpr ext s)
-> m (App ext (E ext s) ('SequenceType tp1)) -> m (SomeExpr ext s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               (TypeRepr tp1
-> E ext s ('SequenceType tp1)
-> E ext s ('SequenceType tp1)
-> App ext (E ext s) ('SequenceType tp1)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1
-> f (SequenceType tp1)
-> f (SequenceType tp1)
-> App ext f (SequenceType tp1)
SequenceAppend TypeRepr tp1
t (E ext s ('SequenceType tp1)
 -> E ext s ('SequenceType tp1)
 -> App ext (E ext s) ('SequenceType tp1))
-> m (E ext s ('SequenceType tp1))
-> m (E ext s ('SequenceType tp1)
      -> App ext (E ext s) ('SequenceType tp1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeRepr ('SequenceType tp1)
-> SomeExpr ext s -> m (E ext s ('SequenceType tp1))
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr (TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp1
t) SomeExpr ext s
x m (E ext s ('SequenceType tp1)
   -> App ext (E ext s) ('SequenceType tp1))
-> m (E ext s ('SequenceType tp1))
-> m (App ext (E ext s) ('SequenceType tp1))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeRepr ('SequenceType tp1)
-> SomeExpr ext s -> m (E ext s ('SequenceType tp1))
forall (m :: * -> *) (t :: CrucibleType) ext s.
MonadSyntax Atomic m =>
TypeRepr t -> SomeExpr ext s -> m (E ext s t)
evalSomeExpr (TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp1
t) SomeExpr ext s
y)
           Maybe (Some TypeRepr)
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"unambiguous sequence append (add a type ascription to disambiguate)" m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    seqNilP :: m (SomeExpr ext s)
    seqNilP :: m (SomeExpr ext s)
seqNilP =
      do Pair TypeRepr tp
t E ext s tp
e <- Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
SequenceIsNil_ m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
         case TypeRepr tp
t of
           SequenceRepr TypeRepr tp1
t' -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr ('BaseToType BaseBoolType)
BoolRepr (E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s)
-> E ext s ('BaseToType BaseBoolType) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseBoolType)
 -> E ext s ('BaseToType BaseBoolType))
-> App ext (E ext s) ('BaseToType BaseBoolType)
-> E ext s ('BaseToType BaseBoolType)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1
-> E ext s ('SequenceType tp1)
-> App ext (E ext s) ('BaseToType BaseBoolType)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1
-> f (SequenceType tp1) -> App ext f ('BaseToType BaseBoolType)
SequenceIsNil TypeRepr tp1
t' E ext s tp
E ext s ('SequenceType tp1)
e
           TypeRepr tp
other -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"sequence (found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    seqLen :: m (SomeExpr ext s)
    seqLen :: m (SomeExpr ext s)
seqLen =
      do Pair TypeRepr tp
t E ext s tp
e <- Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
SequenceLength_ m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
         case TypeRepr tp
t of
           SequenceRepr TypeRepr tp1
t' -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr 'NatType -> E ext s 'NatType -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE TypeRepr 'NatType
NatRepr (E ext s 'NatType -> SomeExpr ext s)
-> E ext s 'NatType -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) 'NatType -> E ext s 'NatType
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) 'NatType -> E ext s 'NatType)
-> App ext (E ext s) 'NatType -> E ext s 'NatType
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1
-> E ext s ('SequenceType tp1) -> App ext (E ext s) 'NatType
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1 -> f (SequenceType tp1) -> App ext f 'NatType
SequenceLength TypeRepr tp1
t' E ext s tp
E ext s ('SequenceType tp1)
e
           TypeRepr tp
other -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"sequence (found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    seqHead :: m (SomeExpr ext s)
    seqHead :: m (SomeExpr ext s)
seqHead =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some (MaybeRepr TypeRepr tp1
t)) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr ('SequenceType tp1) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp1
t))
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         (Pair TypeRepr tp
t E ext s tp
e) <-
            Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
SequenceHead_ (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint)
         case TypeRepr tp
t of
           SequenceRepr TypeRepr tp1
elemT -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('MaybeType tp1)
-> E ext s ('MaybeType tp1) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr TypeRepr tp1
elemT) (E ext s ('MaybeType tp1) -> SomeExpr ext s)
-> E ext s ('MaybeType tp1) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('MaybeType tp1) -> E ext s ('MaybeType tp1)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('MaybeType tp1) -> E ext s ('MaybeType tp1))
-> App ext (E ext s) ('MaybeType tp1) -> E ext s ('MaybeType tp1)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1
-> E ext s ('SequenceType tp1)
-> App ext (E ext s) ('MaybeType tp1)
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1 -> f (SequenceType tp1) -> App ext f ('MaybeType tp1)
SequenceHead TypeRepr tp1
elemT E ext s tp
E ext s ('SequenceType tp1)
e
           TypeRepr tp
other -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"sequence (found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    seqTail :: m (SomeExpr ext s)
    seqTail :: m (SomeExpr ext s)
seqTail =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some (MaybeRepr TypeRepr tp1
t)) -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr tp1 -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr tp1
t)
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         (Pair TypeRepr tp
t E ext s tp
e) <-
            Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
SequenceTail_ (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint)
         case TypeRepr tp
t of
           SequenceRepr TypeRepr tp1
elemT -> SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('MaybeType ('SequenceType tp1))
-> E ext s ('MaybeType ('SequenceType tp1)) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr ('SequenceType tp1)
-> TypeRepr ('MaybeType ('SequenceType tp1))
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr (TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp1
elemT)) (E ext s ('MaybeType ('SequenceType tp1)) -> SomeExpr ext s)
-> E ext s ('MaybeType ('SequenceType tp1)) -> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('MaybeType ('SequenceType tp1))
-> E ext s ('MaybeType ('SequenceType tp1))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('MaybeType ('SequenceType tp1))
 -> E ext s ('MaybeType ('SequenceType tp1)))
-> App ext (E ext s) ('MaybeType ('SequenceType tp1))
-> E ext s ('MaybeType ('SequenceType tp1))
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1
-> E ext s ('SequenceType tp1)
-> App ext (E ext s) ('MaybeType ('SequenceType tp1))
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1
-> f (SequenceType tp1)
-> App ext f ('MaybeType (SequenceType tp1))
SequenceTail TypeRepr tp1
elemT E ext s tp
E ext s ('SequenceType tp1)
e
           TypeRepr tp
other -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"sequence (found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    seqUncons :: m (SomeExpr ext s)
    seqUncons :: m (SomeExpr ext s)
seqUncons =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case Maybe (Some TypeRepr)
typeHint of
                         Just (Some (MaybeRepr (StructRepr (Assignment TypeRepr ctx
Ctx.Empty Ctx.:> TypeRepr tp
t Ctx.:> TypeRepr tp
_)))) ->
                           Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr ('SequenceType tp) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (TypeRepr tp -> TypeRepr ('SequenceType tp)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp
t))
                         Maybe (Some TypeRepr)
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         (Pair TypeRepr tp
t E ext s tp
e) <-
            Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
SequenceUncons_ (SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint)
         case TypeRepr tp
t of
           SequenceRepr TypeRepr tp1
elemT ->
             SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr
  ('MaybeType
     ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
-> E ext
     s
     ('MaybeType
        ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
-> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (TypeRepr ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1))
-> TypeRepr
     ('MaybeType
        ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('MaybeType tp1)
MaybeRepr (CtxRepr ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)
-> TypeRepr
     ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1))
forall (ctx :: Ctx CrucibleType).
CtxRepr ctx -> TypeRepr ('StructType ctx)
StructRepr (Assignment TypeRepr EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> *).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty Assignment TypeRepr EmptyCtx
-> TypeRepr tp1 -> Assignment TypeRepr (EmptyCtx ::> tp1)
forall {k} (ctx' :: Ctx k) (f :: k -> *) (ctx :: Ctx k) (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> TypeRepr tp1
elemT Assignment TypeRepr (EmptyCtx ::> tp1)
-> TypeRepr ('SequenceType tp1)
-> CtxRepr ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)
forall {k} (ctx' :: Ctx k) (f :: k -> *) (ctx :: Ctx k) (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
forall (tp1 :: CrucibleType).
TypeRepr tp1 -> TypeRepr ('SequenceType tp1)
SequenceRepr TypeRepr tp1
elemT))) (E ext
   s
   ('MaybeType
      ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
 -> SomeExpr ext s)
-> E ext
     s
     ('MaybeType
        ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
-> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$
               App
  ext
  (E ext s)
  ('MaybeType
     ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
-> E ext
     s
     ('MaybeType
        ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App
   ext
   (E ext s)
   ('MaybeType
      ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
 -> E ext
      s
      ('MaybeType
         ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1))))
-> App
     ext
     (E ext s)
     ('MaybeType
        ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
-> E ext
     s
     ('MaybeType
        ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1
-> E ext s ('SequenceType tp1)
-> App
     ext
     (E ext s)
     ('MaybeType
        ('StructType ((EmptyCtx ::> tp1) ::> 'SequenceType tp1)))
forall (tp1 :: CrucibleType) (f :: CrucibleType -> *) ext.
TypeRepr tp1
-> f (SequenceType tp1)
-> App
     ext
     f
     ('MaybeType (StructType ((EmptyCtx ::> tp1) ::> SequenceType tp1)))
SequenceUncons TypeRepr tp1
elemT E ext s tp
E ext s ('SequenceType tp1)
e
           TypeRepr tp
other -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"sequence (found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
other) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    showExpr :: m (SomeExpr ext s)
    showExpr :: m (SomeExpr ext s)
showExpr =
      do Pair TypeRepr tp
t1 E ext s tp
e <- Keyword
-> m (Pair TypeRepr (E ext s)) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Show m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
         case TypeRepr tp
t1 of
           FloatRepr FloatInfoRepr flt
fi ->
             SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr) (E ext s ('BaseToType (BaseStringType 'Unicode)) -> SomeExpr ext s)
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
 -> E ext s ('BaseToType (BaseStringType 'Unicode)))
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall a b. (a -> b) -> a -> b
$ FloatInfoRepr flt
-> E ext s ('FloatType flt)
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
forall (fi :: FloatInfo) (f :: CrucibleType -> *) ext.
FloatInfoRepr fi
-> f (FloatType fi)
-> App ext f ('BaseToType (BaseStringType 'Unicode))
ShowFloat FloatInfoRepr flt
fi E ext s tp
E ext s ('FloatType flt)
e
           TypeRepr tp
NatRepr ->
             let toint :: E ext s ('BaseToType BaseIntegerType)
toint = App ext (E ext s) ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType BaseIntegerType)
 -> E ext s ('BaseToType BaseIntegerType))
-> App ext (E ext s) ('BaseToType BaseIntegerType)
-> E ext s ('BaseToType BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ E ext s 'NatType -> App ext (E ext s) ('BaseToType BaseIntegerType)
forall (f :: CrucibleType -> *) ext.
f 'NatType -> App ext f ('BaseToType BaseIntegerType)
NatToInteger E ext s tp
E ext s 'NatType
e
                 showint :: E ext s ('BaseToType (BaseStringType 'Unicode))
showint = App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
 -> E ext s ('BaseToType (BaseStringType 'Unicode)))
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr BaseIntegerType
-> E ext s ('BaseToType BaseIntegerType)
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
forall (bt :: BaseType) (f :: CrucibleType -> *) ext.
BaseTypeRepr bt
-> f (BaseToType bt)
-> App ext f ('BaseToType (BaseStringType 'Unicode))
ShowValue BaseTypeRepr BaseIntegerType
BaseIntegerRepr E ext s ('BaseToType BaseIntegerType)
toint
             in SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr) E ext s ('BaseToType (BaseStringType 'Unicode))
showint
           (TypeRepr tp -> AsBaseType tp
forall (tp :: CrucibleType). TypeRepr tp -> AsBaseType tp
asBaseType -> AsBaseType BaseTypeRepr bt
bt) ->
             SomeExpr ext s -> m (SomeExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeExpr ext s -> m (SomeExpr ext s))
-> SomeExpr ext s -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr) (E ext s ('BaseToType (BaseStringType 'Unicode)) -> SomeExpr ext s)
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> SomeExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
 -> E ext s ('BaseToType (BaseStringType 'Unicode)))
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr bt
-> E ext s (BaseToType bt)
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
forall (bt :: BaseType) (f :: CrucibleType -> *) ext.
BaseTypeRepr bt
-> f (BaseToType bt)
-> App ext f ('BaseToType (BaseStringType 'Unicode))
ShowValue BaseTypeRepr bt
bt E ext s tp
E ext s (BaseToType bt)
e
           TypeRepr tp
_ -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeExpr ext s) -> m (SomeExpr ext s))
-> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeExpr ext s) -> m (SomeExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"base or floating point type, but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
t1)) m (SomeExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty


buildStruct :: [Pair TypeRepr (E ext s)] -> SomeExpr ext s
buildStruct :: forall ext s. [Pair TypeRepr (E ext s)] -> SomeExpr ext s
buildStruct = Assignment TypeRepr EmptyCtx
-> Assignment (E ext s) EmptyCtx
-> [Pair TypeRepr (E ext s)]
-> SomeExpr ext s
forall (ctx :: Ctx CrucibleType) ext s.
Assignment TypeRepr ctx
-> Assignment (E ext s) ctx
-> [Pair TypeRepr (E ext s)]
-> SomeExpr ext s
loop Assignment TypeRepr EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> *).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty Assignment (E ext s) EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> *).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty
  where
    loop :: Ctx.Assignment TypeRepr ctx -> Ctx.Assignment (E ext s) ctx -> [Pair TypeRepr (E ext s)] -> SomeExpr ext s
    loop :: forall (ctx :: Ctx CrucibleType) ext s.
Assignment TypeRepr ctx
-> Assignment (E ext s) ctx
-> [Pair TypeRepr (E ext s)]
-> SomeExpr ext s
loop Assignment TypeRepr ctx
tps Assignment (E ext s) ctx
vs [] = TypeRepr ('StructType ctx)
-> E ext s ('StructType ctx) -> SomeExpr ext s
forall (ty :: CrucibleType) ext s.
TypeRepr ty -> E ext s ty -> SomeExpr ext s
SomeE (Assignment TypeRepr ctx -> TypeRepr ('StructType ctx)
forall (ctx :: Ctx CrucibleType).
CtxRepr ctx -> TypeRepr ('StructType ctx)
StructRepr Assignment TypeRepr ctx
tps) (App ext (E ext s) ('StructType ctx) -> E ext s ('StructType ctx)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (Assignment TypeRepr ctx
-> Assignment (E ext s) ctx -> App ext (E ext s) ('StructType ctx)
forall (ctx :: Ctx CrucibleType) (f :: CrucibleType -> *) ext.
CtxRepr ctx -> Assignment f ctx -> App ext f ('StructType ctx)
MkStruct Assignment TypeRepr ctx
tps Assignment (E ext s) ctx
vs))
    loop Assignment TypeRepr ctx
tps Assignment (E ext s) ctx
vs (Pair TypeRepr tp
tp E ext s tp
x:[Pair TypeRepr (E ext s)]
xs) = Assignment TypeRepr (ctx ::> tp)
-> Assignment (E ext s) (ctx ::> tp)
-> [Pair TypeRepr (E ext s)]
-> SomeExpr ext s
forall (ctx :: Ctx CrucibleType) ext s.
Assignment TypeRepr ctx
-> Assignment (E ext s) ctx
-> [Pair TypeRepr (E ext s)]
-> SomeExpr ext s
loop (Assignment TypeRepr ctx
tps Assignment TypeRepr ctx
-> TypeRepr tp -> Assignment TypeRepr (ctx ::> tp)
forall {k} (ctx' :: Ctx k) (f :: k -> *) (ctx :: Ctx k) (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> TypeRepr tp
tp) (Assignment (E ext s) ctx
vs Assignment (E ext s) ctx
-> E ext s tp -> Assignment (E ext s) (ctx ::> tp)
forall {k} (ctx' :: Ctx k) (f :: k -> *) (ctx :: Ctx k) (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> E ext s tp
x) [Pair TypeRepr (E ext s)]
xs

data NatHint
  = NoHint
  | forall w. (1 <= w) => NatHint (NatRepr w)

synthBV :: forall m s ext.
  ( MonadReader (SyntaxState s) m
  , MonadSyntax Atomic m
  , ?parserHooks :: ParserHooks ext ) =>
  NatHint ->
  m (SomeBVExpr ext s)
synthBV :: forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
NatHint -> m (SomeBVExpr ext s)
synthBV NatHint
widthHint =
   m (SomeBVExpr ext s)
bvLit m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeBVExpr ext s)
bvConcat m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeBVExpr ext s)
bvSelect m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeBVExpr ext s)
bvTrunc m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   m (SomeBVExpr ext s)
bvZext m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeBVExpr ext s)
bvSext m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (SomeBVExpr ext s)
boolToBV m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> Integer
-> m (SomeBVExpr ext s)
naryBV Keyword
BVAnd_ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAnd Integer
1 m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> Integer
-> m (SomeBVExpr ext s)
naryBV Keyword
BVOr_ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVOr Integer
0 m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> Integer
-> m (SomeBVExpr ext s)
naryBV Keyword
BVXor_ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVXor Integer
0 m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> m (SomeBVExpr ext s)
binaryBV Keyword
Sdiv NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSdiv m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> m (SomeBVExpr ext s)
binaryBV Keyword
Smod NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVSrem m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> m (SomeBVExpr ext s)
binaryBV Keyword
BVShl_ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVShl m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> m (SomeBVExpr ext s)
binaryBV Keyword
BVLshr_ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVLshr m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> m (SomeBVExpr ext s)
binaryBV Keyword
BVAshr_ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> f (BVType w) -> App ext f (BVType w)
BVAshr m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
   Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w))
-> m (SomeBVExpr ext s)
unaryBV Keyword
Negate NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> App ext f (BVType w)
BVNeg m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w))
-> m (SomeBVExpr ext s)
unaryBV Keyword
BVNot_ NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w -> f (BVType w) -> App ext f (BVType w)
BVNot

 where
    bvSubterm :: NatHint -> m (SomeBVExpr ext s)
    bvSubterm :: NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
hint =
      do let newhint :: Maybe (Some TypeRepr)
newhint = case NatHint
hint of
                         NatHint NatRepr w
w -> Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr ('BaseToType (BaseBVType w)) -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (NatRepr w -> TypeRepr ('BaseToType (BaseBVType w))
forall (n :: Natural).
(1 <= n) =>
NatRepr n -> TypeRepr ('BaseToType (BaseBVType n))
BVRepr NatRepr w
w))
                         NatHint
_ -> Maybe (Some TypeRepr)
forall a. Maybe a
Nothing
         (Pair TypeRepr tp
t E ext s tp
x) <- SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr Maybe (Some TypeRepr)
newhint
         case TypeRepr tp
t of
           BVRepr NatRepr n
w -> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NatRepr n
-> E ext s ('BaseToType (BaseBVType n)) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr n
w E ext s tp
E ext s ('BaseToType (BaseBVType n))
x)
           TypeRepr tp
_ -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"bitvector expression" (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ m (SomeBVExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    bvLit :: m (SomeBVExpr ext s)
    bvLit :: m (SomeBVExpr ext s)
bvLit =
      Text -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"bitvector literal" (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$
      do (BoundedNat NatRepr w
w, Integer
i) <- Keyword -> m PosNat -> m Integer -> m (PosNat, Integer)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
BV m PosNat
forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat m Integer
forall (m :: * -> *). MonadSyntax Atomic m => m Integer
int
         SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
w (E ext s (BVType w) -> SomeBVExpr ext s)
-> E ext s (BVType w) -> SomeBVExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> App ext (E ext s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> *).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)

    unaryBV :: Keyword
          -> (forall w. (1 <= w) => NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w))
          -> m (SomeBVExpr ext s)
    unaryBV :: Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w))
-> m (SomeBVExpr ext s)
unaryBV Keyword
k forall (w :: Natural).
(1 <= w) =>
NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
f =
      do SomeBVExpr NatRepr w
wx E ext s (BVType w)
x <- Keyword -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
k (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
widthHint)
         SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
wx (E ext s (BVType w) -> SomeBVExpr ext s)
-> E ext s (BVType w) -> SomeBVExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
f NatRepr w
wx E ext s (BVType w)
x

    binaryBV :: Keyword
          -> (forall w. (1 <= w) => NatRepr w -> E ext s (BVType w) -> E ext s (BVType w) -> App ext (E ext s) (BVType w))
          -> m (SomeBVExpr ext s)
    binaryBV :: Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> m (SomeBVExpr ext s)
binaryBV Keyword
k forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
f =
      do (SomeBVExpr NatRepr w
wx E ext s (BVType w)
x, SomeBVExpr NatRepr w
wy E ext s (BVType w)
y) <- Keyword
-> m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s, SomeBVExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
k (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
widthHint) (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
widthHint)
         case NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
wx NatRepr w
wy of
           Just w :~: w
Refl -> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
wx (E ext s (BVType w) -> SomeBVExpr ext s)
-> E ext s (BVType w) -> SomeBVExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
f NatRepr w
wx E ext s (BVType w)
x E ext s (BVType w)
E ext s (BVType w)
y
           Maybe (w :~: w)
Nothing -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$
             Text -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"bitwise expression arguments with matching widths (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                       String -> Text
T.pack (NatRepr w -> String
forall a. Show a => a -> String
show NatRepr w
wx) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" /= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NatRepr w -> String
forall a. Show a => a -> String
show NatRepr w
wy) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
                      m (SomeBVExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    naryBV :: Keyword
          -> (forall w. (1 <= w) => NatRepr w -> E ext s (BVType w) -> E ext s (BVType w) -> App ext (E ext s) (BVType w))
          -> Integer
          -> m (SomeBVExpr ext s)
    naryBV :: Keyword
-> (forall (w :: Natural).
    (1 <= w) =>
    NatRepr w
    -> E ext s (BVType w)
    -> E ext s (BVType w)
    -> App ext (E ext s) (BVType w))
-> Integer
-> m (SomeBVExpr ext s)
naryBV Keyword
k forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
f Integer
u =
      do [SomeBVExpr ext s]
args <- Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
k m () -> m [SomeBVExpr ext s] -> m [SomeBVExpr ext s]
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy` m (SomeBVExpr ext s) -> m [SomeBVExpr ext s]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m [a]
rep (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
widthHint))
         case [SomeBVExpr ext s]
args of
           [] -> case NatHint
widthHint of
                   NatHint
NoHint    -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"ambiguous width" m (SomeBVExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
                   NatHint NatRepr w
w -> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
w (E ext s (BVType w) -> SomeBVExpr ext s)
-> E ext s (BVType w) -> SomeBVExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> App ext (E ext s) (BVType w)
forall (w :: Natural) ext (f :: CrucibleType -> *).
(1 <= w) =>
NatRepr w -> BV w -> App ext f ('BaseToType (BaseBVType w))
BVLit NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
u)
           (SomeBVExpr NatRepr w
wx E ext s (BVType w)
x:[SomeBVExpr ext s]
xs) -> NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
wx (E ext s (BVType w) -> SomeBVExpr ext s)
-> m (E ext s (BVType w)) -> m (SomeBVExpr ext s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NatRepr w
-> E ext s (BVType w)
-> [SomeBVExpr ext s]
-> m (E ext s (BVType w))
forall (w :: Natural).
NatRepr w
-> E ext s (BVType w)
-> [SomeBVExpr ext s]
-> m (E ext s (BVType w))
go NatRepr w
wx E ext s (BVType w)
x [SomeBVExpr ext s]
xs

     where
     go :: forall w. NatRepr w -> E ext s (BVType w) -> [SomeBVExpr ext s] -> m (E ext s (BVType w))
     go :: forall (w :: Natural).
NatRepr w
-> E ext s (BVType w)
-> [SomeBVExpr ext s]
-> m (E ext s (BVType w))
go NatRepr w
_wx E ext s (BVType w)
x [] = E ext s (BVType w) -> m (E ext s (BVType w))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return E ext s (BVType w)
x
     go NatRepr w
wx E ext s (BVType w)
x (SomeBVExpr NatRepr w
wy E ext s (BVType w)
y : [SomeBVExpr ext s]
ys) =
       case NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
wx NatRepr w
wy of
         Just w :~: w
Refl -> NatRepr w
-> E ext s (BVType w)
-> [SomeBVExpr ext s]
-> m (E ext s (BVType w))
forall (w :: Natural).
NatRepr w
-> E ext s (BVType w)
-> [SomeBVExpr ext s]
-> m (E ext s (BVType w))
go NatRepr w
wx (App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
f NatRepr w
wx E ext s (BVType w)
x E ext s (BVType w)
E ext s (BVType w)
y) [SomeBVExpr ext s]
ys
         Maybe (w :~: w)
Nothing   -> m (E ext s (BVType w)) -> m (E ext s (BVType w))
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (E ext s (BVType w)) -> m (E ext s (BVType w)))
-> m (E ext s (BVType w)) -> m (E ext s (BVType w))
forall a b. (a -> b) -> a -> b
$
              Text -> m (E ext s (BVType w)) -> m (E ext s (BVType w))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"bitwise expression arguments with matching widths (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                        String -> Text
T.pack (NatRepr w -> String
forall a. Show a => a -> String
show NatRepr w
wx) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" /= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (NatRepr w -> String
forall a. Show a => a -> String
show NatRepr w
wy) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
                       m (E ext s (BVType w))
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    boolToBV :: m (SomeBVExpr ext s)
    boolToBV :: m (SomeBVExpr ext s)
boolToBV =
      do (BoundedNat NatRepr w
w, E ext s ('BaseToType BaseBoolType)
x) <- Keyword
-> m PosNat
-> m (E ext s ('BaseToType BaseBoolType))
-> m (PosNat, E ext s ('BaseToType BaseBoolType))
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
BoolToBV_ m PosNat
forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat (TypeRepr ('BaseToType BaseBoolType)
-> m (E ext s ('BaseToType BaseBoolType))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ('BaseToType BaseBoolType)
BoolRepr)
         SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
w (E ext s (BVType w) -> SomeBVExpr ext s)
-> E ext s (BVType w) -> SomeBVExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> E ext s ('BaseToType BaseBoolType)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w) =>
NatRepr w
-> f ('BaseToType BaseBoolType)
-> App ext f ('BaseToType (BaseBVType w))
BoolToBV NatRepr w
w E ext s ('BaseToType BaseBoolType)
x

    bvSelect :: m (SomeBVExpr ext s)
    bvSelect :: m (SomeBVExpr ext s)
bvSelect =
      do (Some NatRepr x
idx, (BoundedNat NatRepr w
len, (SomeBVExpr NatRepr w
w E ext s (BVType w)
x, ()))) <-
             m ()
-> m (Some NatRepr, (PosNat, (SomeBVExpr ext s, ())))
-> m (Some NatRepr, (PosNat, (SomeBVExpr ext s, ())))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
BVSelect_) (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
commit m ()
-> m (Some NatRepr, (PosNat, (SomeBVExpr ext s, ())))
-> m (Some NatRepr, (PosNat, (SomeBVExpr ext s, ())))
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (Some NatRepr)
-> m (PosNat, (SomeBVExpr ext s, ()))
-> m (Some NatRepr, (PosNat, (SomeBVExpr ext s, ())))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m (Some NatRepr)
forall (m :: * -> *). MonadSyntax Atomic m => m (Some NatRepr)
natRepr (m PosNat
-> m (SomeBVExpr ext s, ()) -> m (PosNat, (SomeBVExpr ext s, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m PosNat
forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat (m (SomeBVExpr ext s) -> m () -> m (SomeBVExpr ext s, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
NoHint) m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList)))
         case NatRepr (x + w) -> NatRepr w -> Maybe (LeqProof (x + w) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr x -> NatRepr w -> NatRepr (x + w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr x
idx NatRepr w
len) NatRepr w
w of
           Just LeqProof (x + w) w
LeqProof -> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
len (E ext s (BVType w) -> SomeBVExpr ext s)
-> E ext s (BVType w) -> SomeBVExpr ext s
forall a b. (a -> b) -> a -> b
$ App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr x
-> NatRepr w
-> NatRepr w
-> E ext s (BVType w)
-> App ext (E ext s) (BVType w)
forall (w :: Natural) (len :: Natural) (idx :: Natural)
       (f :: CrucibleType -> *) ext.
(1 <= w, 1 <= len, (idx + len) <= w) =>
NatRepr idx
-> NatRepr len
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType len))
BVSelect NatRepr x
idx NatRepr w
len NatRepr w
w E ext s (BVType w)
x
           Maybe (LeqProof (x + w) w)
_ -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"valid bitvector select") (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ m (SomeBVExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    bvConcat :: m (SomeBVExpr ext s)
    bvConcat :: m (SomeBVExpr ext s)
bvConcat =
      do (SomeBVExpr NatRepr w
wx E ext s (BVType w)
x, SomeBVExpr NatRepr w
wy E ext s (BVType w)
y) <- Keyword
-> m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s)
-> m (SomeBVExpr ext s, SomeBVExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
BVConcat_ (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
NoHint) (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
NoHint)
         LeqProof 1 (w + w)
-> ((1 <= (w + w)) => m (SomeBVExpr ext s)) -> m (SomeBVExpr ext s)
forall (m :: Natural) (n :: Natural) a.
LeqProof m n -> ((m <= n) => a) -> a
withLeqProof (LeqProof 1 w -> NatRepr w -> LeqProof 1 (w + w)
forall (f :: Natural -> *) (m :: Natural) (n :: Natural)
       (p :: Natural).
LeqProof m n -> f p -> LeqProof m (n + p)
leqAdd (NatRepr 1 -> NatRepr w -> LeqProof 1 w
forall (m :: Natural) (n :: Natural) (f :: Natural -> *)
       (g :: Natural -> *).
(m <= n) =>
f m -> g n -> LeqProof m n
leqProof (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) NatRepr w
wx) NatRepr w
wy) (((1 <= (w + w)) => m (SomeBVExpr ext s)) -> m (SomeBVExpr ext s))
-> ((1 <= (w + w)) => m (SomeBVExpr ext s)) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$
           SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr (w + w) -> E ext s (BVType (w + w)) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr (NatRepr w -> NatRepr w -> NatRepr (w + w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr w
wx NatRepr w
wy) (App ext (E ext s) (BVType (w + w)) -> E ext s (BVType (w + w))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType (w + w)) -> E ext s (BVType (w + w)))
-> App ext (E ext s) (BVType (w + w)) -> E ext s (BVType (w + w))
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> NatRepr w
-> E ext s (BVType w)
-> E ext s (BVType w)
-> App ext (E ext s) (BVType (w + w))
forall (u :: Natural) (v :: Natural) (f :: CrucibleType -> *) ext.
(1 <= u, 1 <= v, 1 <= (u + v)) =>
NatRepr u
-> NatRepr v
-> f (BVType u)
-> f (BVType v)
-> App ext f ('BaseToType (BaseBVType (u + v)))
BVConcat NatRepr w
wx NatRepr w
wy E ext s (BVType w)
x E ext s (BVType w)
y)

    bvTrunc :: m (SomeBVExpr ext s)
    bvTrunc :: m (SomeBVExpr ext s)
bvTrunc =
      do (BoundedNat NatRepr w
r, SomeBVExpr NatRepr w
w E ext s (BVType w)
x) <- Keyword
-> m PosNat -> m (SomeBVExpr ext s) -> m (PosNat, SomeBVExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
BVTrunc_ m PosNat
forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
NoHint)
         case NatRepr (w + 1) -> NatRepr w -> Maybe (LeqProof (w + 1) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat NatRepr w
r) NatRepr w
w of
           Just LeqProof (w + 1) w
LeqProof -> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
r (App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
forall (r :: Natural) (w :: Natural) (f :: CrucibleType -> *) ext.
(1 <= r, (r + 1) <= w) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVTrunc NatRepr w
r NatRepr w
w E ext s (BVType w)
x)
           Maybe (LeqProof (w + 1) w)
_ -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"valid bitvector truncation" (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ m (SomeBVExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    bvZext :: m (SomeBVExpr ext s)
    bvZext :: m (SomeBVExpr ext s)
bvZext =
      do (BoundedNat NatRepr w
r, SomeBVExpr NatRepr w
w E ext s (BVType w)
x) <- Keyword
-> m PosNat -> m (SomeBVExpr ext s) -> m (PosNat, SomeBVExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
BVZext_ m PosNat
forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
NoHint)
         case NatRepr (w + 1) -> NatRepr w -> Maybe (LeqProof (w + 1) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat NatRepr w
w) NatRepr w
r of
           Just LeqProof (w + 1) w
LeqProof -> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
r (App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVZext NatRepr w
r NatRepr w
w E ext s (BVType w)
x)
           Maybe (LeqProof (w + 1) w)
_ -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"valid zero extension" (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ m (SomeBVExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    bvSext :: m (SomeBVExpr ext s)
    bvSext :: m (SomeBVExpr ext s)
bvSext =
      do (BoundedNat NatRepr w
r, SomeBVExpr NatRepr w
w E ext s (BVType w)
x) <- Keyword
-> m PosNat -> m (SomeBVExpr ext s) -> m (PosNat, SomeBVExpr ext s)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
BVSext_ m PosNat
forall (m :: * -> *). MonadSyntax Atomic m => m PosNat
posNat (NatHint -> m (SomeBVExpr ext s)
bvSubterm NatHint
NoHint)
         case NatRepr (w + 1) -> NatRepr w -> Maybe (LeqProof (w + 1) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat NatRepr w
w) NatRepr w
r of
           Just LeqProof (w + 1) w
LeqProof -> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBVExpr ext s -> m (SomeBVExpr ext s))
-> SomeBVExpr ext s -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> E ext s (BVType w) -> SomeBVExpr ext s
forall (ty :: Natural) ext s.
(1 <= ty) =>
NatRepr ty -> E ext s (BVType ty) -> SomeBVExpr ext s
SomeBVExpr NatRepr w
r (App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (App ext (E ext s) (BVType w) -> E ext s (BVType w))
-> App ext (E ext s) (BVType w) -> E ext s (BVType w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> NatRepr w -> E ext s (BVType w) -> App ext (E ext s) (BVType w)
forall (w :: Natural) (r :: Natural) (f :: CrucibleType -> *) ext.
(1 <= w, 1 <= r, (w + 1) <= r) =>
NatRepr r
-> NatRepr w
-> f (BVType w)
-> App ext f ('BaseToType (BaseBVType r))
BVSext NatRepr w
r NatRepr w
w E ext s (BVType w)
x)
           Maybe (LeqProof (w + 1) w)
_ -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ Text -> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"valid zero extension" (m (SomeBVExpr ext s) -> m (SomeBVExpr ext s))
-> m (SomeBVExpr ext s) -> m (SomeBVExpr ext s)
forall a b. (a -> b) -> a -> b
$ m (SomeBVExpr ext s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty


check :: forall m t s ext
       . ( MonadReader (SyntaxState s) m
         , MonadSyntax Atomic m
         , ?parserHooks :: ParserHooks ext )
       => TypeRepr t -> m (E ext s t)
check :: forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr t
t =
  Text -> m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"inhabitant of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr t -> String
forall a. Show a => a -> String
show TypeRepr t
t)) (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$
    do Pair TypeRepr tp
t' E ext s tp
e <- SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) ext s.
MonadSyntax Atomic m =>
SomeExpr ext s -> m (Pair TypeRepr (E ext s))
forceSynth (SomeExpr ext s -> m (Pair TypeRepr (E ext s)))
-> m (SomeExpr ext s) -> m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Some TypeRepr) -> m (SomeExpr ext s)
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
Maybe (Some TypeRepr) -> m (SomeExpr ext s)
synthExpr (Some TypeRepr -> Maybe (Some TypeRepr)
forall a. a -> Maybe a
Just (TypeRepr t -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr t
t))
       m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$ Text -> m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr t -> String
forall a. Show a => a -> String
show TypeRepr t
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" rather than a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
t')) (m (E ext s t) -> m (E ext s t)) -> m (E ext s t) -> m (E ext s t)
forall a b. (a -> b) -> a -> b
$
         case TypeRepr t -> TypeRepr tp -> Maybe (t :~: tp)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr t
t TypeRepr tp
t' of
           Maybe (t :~: tp)
Nothing -> m (E ext s t) -> m (E ext s t)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later m (E ext s t)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
           Just t :~: tp
Refl -> E ext s t -> m (E ext s t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return E ext s t
E ext s tp
e

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

data LabelInfo :: Type -> Type where
  NoArgLbl :: Label s -> LabelInfo s
  ArgLbl :: forall s ty . LambdaLabel s ty -> LabelInfo s

data ProgramState s =
  ProgramState { forall {k} (s :: k).
ProgramState s -> Map FunctionName FunctionHeader
_progFunctions :: Map FunctionName FunctionHeader
               , forall {k} (s :: k).
ProgramState s -> Map FunctionName FunctionHeader
_progForwardDecs :: Map FunctionName FunctionHeader
               , forall {k} (s :: k).
ProgramState s -> Map GlobalName (Some GlobalVar)
_progGlobals :: Map GlobalName (Some GlobalVar)
               , forall {k} (s :: k).
ProgramState s -> Map GlobalName (Some GlobalVar)
_progExterns :: Map GlobalName (Some GlobalVar)
               , forall {k} (s :: k). ProgramState s -> HandleAllocator
_progHandleAlloc :: HandleAllocator
               }

progFunctions :: Simple Lens (ProgramState s) (Map FunctionName FunctionHeader)
progFunctions :: forall {k} (s :: k) (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> ProgramState s -> f (ProgramState s)
progFunctions = (ProgramState s -> Map FunctionName FunctionHeader)
-> (ProgramState s
    -> Map FunctionName FunctionHeader -> ProgramState s)
-> Lens
     (ProgramState s)
     (ProgramState s)
     (Map FunctionName FunctionHeader)
     (Map FunctionName FunctionHeader)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramState s -> Map FunctionName FunctionHeader
forall {k} (s :: k).
ProgramState s -> Map FunctionName FunctionHeader
_progFunctions (\ProgramState s
s Map FunctionName FunctionHeader
v -> ProgramState s
s { _progFunctions = v })

progForwardDecs :: Simple Lens (ProgramState s) (Map FunctionName FunctionHeader)
progForwardDecs :: forall {k} (s :: k) (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> ProgramState s -> f (ProgramState s)
progForwardDecs = (ProgramState s -> Map FunctionName FunctionHeader)
-> (ProgramState s
    -> Map FunctionName FunctionHeader -> ProgramState s)
-> Lens
     (ProgramState s)
     (ProgramState s)
     (Map FunctionName FunctionHeader)
     (Map FunctionName FunctionHeader)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramState s -> Map FunctionName FunctionHeader
forall {k} (s :: k).
ProgramState s -> Map FunctionName FunctionHeader
_progForwardDecs (\ProgramState s
s Map FunctionName FunctionHeader
v -> ProgramState s
s { _progForwardDecs = v })

progGlobals :: Simple Lens (ProgramState s) (Map GlobalName (Some GlobalVar))
progGlobals :: forall {k} (s :: k) (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> ProgramState s -> f (ProgramState s)
progGlobals = (ProgramState s -> Map GlobalName (Some GlobalVar))
-> (ProgramState s
    -> Map GlobalName (Some GlobalVar) -> ProgramState s)
-> Lens
     (ProgramState s)
     (ProgramState s)
     (Map GlobalName (Some GlobalVar))
     (Map GlobalName (Some GlobalVar))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramState s -> Map GlobalName (Some GlobalVar)
forall {k} (s :: k).
ProgramState s -> Map GlobalName (Some GlobalVar)
_progGlobals (\ProgramState s
s Map GlobalName (Some GlobalVar)
v -> ProgramState s
s { _progGlobals = v })

progExterns :: Simple Lens (ProgramState s) (Map GlobalName (Some GlobalVar))
progExterns :: forall {k} (s :: k) (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> ProgramState s -> f (ProgramState s)
progExterns = (ProgramState s -> Map GlobalName (Some GlobalVar))
-> (ProgramState s
    -> Map GlobalName (Some GlobalVar) -> ProgramState s)
-> Lens
     (ProgramState s)
     (ProgramState s)
     (Map GlobalName (Some GlobalVar))
     (Map GlobalName (Some GlobalVar))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramState s -> Map GlobalName (Some GlobalVar)
forall {k} (s :: k).
ProgramState s -> Map GlobalName (Some GlobalVar)
_progExterns (\ProgramState s
s Map GlobalName (Some GlobalVar)
v -> ProgramState s
s { _progExterns = v })

progHandleAlloc :: Simple Lens (ProgramState s) HandleAllocator
progHandleAlloc :: forall {k} (s :: k) (f :: * -> *).
Functor f =>
(HandleAllocator -> f HandleAllocator)
-> ProgramState s -> f (ProgramState s)
progHandleAlloc = (ProgramState s -> HandleAllocator)
-> (ProgramState s -> HandleAllocator -> ProgramState s)
-> Lens
     (ProgramState s) (ProgramState s) HandleAllocator HandleAllocator
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ProgramState s -> HandleAllocator
forall {k} (s :: k). ProgramState s -> HandleAllocator
_progHandleAlloc (\ProgramState s
s HandleAllocator
v -> ProgramState s
s { _progHandleAlloc = v })


data SyntaxState s =
  SyntaxState { forall s. SyntaxState s -> Map LabelName (LabelInfo s)
_stxLabels :: Map LabelName (LabelInfo s)
              , forall s. SyntaxState s -> Map AtomName (Some (Atom s))
_stxAtoms :: Map AtomName (Some (Atom s))
              , forall s. SyntaxState s -> Map RegName (Some (Reg s))
_stxRegisters :: Map RegName (Some (Reg s))
              , forall s. SyntaxState s -> NonceGenerator IO s
_stxNonceGen :: NonceGenerator IO s
              , forall s. SyntaxState s -> ProgramState s
_stxProgState :: ProgramState s
              }

initProgState :: [(SomeHandle,Position)] -> HandleAllocator -> ProgramState s
initProgState :: forall {k} (s :: k).
[(SomeHandle, Position)] -> HandleAllocator -> ProgramState s
initProgState [(SomeHandle, Position)]
builtIns HandleAllocator
ha = Map FunctionName FunctionHeader
-> Map FunctionName FunctionHeader
-> Map GlobalName (Some GlobalVar)
-> Map GlobalName (Some GlobalVar)
-> HandleAllocator
-> ProgramState s
forall {k} (s :: k).
Map FunctionName FunctionHeader
-> Map FunctionName FunctionHeader
-> Map GlobalName (Some GlobalVar)
-> Map GlobalName (Some GlobalVar)
-> HandleAllocator
-> ProgramState s
ProgramState Map FunctionName FunctionHeader
fns Map FunctionName FunctionHeader
forall k a. Map k a
Map.empty Map GlobalName (Some GlobalVar)
forall k a. Map k a
Map.empty Map GlobalName (Some GlobalVar)
forall k a. Map k a
Map.empty HandleAllocator
ha
  where
  f :: Assignment TypeRepr ctx -> Assignment Arg ctx
f Assignment TypeRepr ctx
tps = Size ctx
-> (forall (tp :: CrucibleType). Index ctx tp -> Arg tp)
-> Assignment Arg ctx
forall {k} (ctx :: Ctx k) (f :: k -> *).
Size ctx
-> (forall (tp :: k). Index ctx tp -> f tp) -> Assignment f ctx
Ctx.generate
            (Assignment TypeRepr ctx -> Size ctx
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size Assignment TypeRepr ctx
tps)
            (\Index ctx tp
i -> AtomName -> Position -> TypeRepr tp -> Arg tp
forall (t :: CrucibleType).
AtomName -> Position -> TypeRepr t -> Arg t
Arg (Text -> AtomName
AtomName (Text
"arg" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (Index ctx tp -> String
forall a. Show a => a -> String
show Index ctx tp
i)))) Position
InternalPos (Assignment TypeRepr ctx
tps Assignment TypeRepr ctx -> Index ctx tp -> TypeRepr tp
forall {k} (f :: k -> *) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index ctx tp
i))
  fns :: Map FunctionName FunctionHeader
fns = [(FunctionName, FunctionHeader)] -> Map FunctionName FunctionHeader
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (FnHandle args ret -> FunctionName
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FnHandle args ret -> FunctionName
handleName FnHandle args ret
h,
            FunctionName
-> Assignment Arg args
-> TypeRepr ret
-> FnHandle args ret
-> Position
-> FunctionHeader
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FunctionName
-> Assignment Arg args
-> TypeRepr ret
-> FnHandle args ret
-> Position
-> FunctionHeader
FunctionHeader
              (FnHandle args ret -> FunctionName
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FnHandle args ret -> FunctionName
handleName FnHandle args ret
h)
              (Assignment TypeRepr args -> Assignment Arg args
forall {ctx :: Ctx CrucibleType}.
Assignment TypeRepr ctx -> Assignment Arg ctx
f (FnHandle args ret -> Assignment TypeRepr args
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FnHandle args ret -> CtxRepr args
handleArgTypes FnHandle args ret
h))
              (FnHandle args ret -> TypeRepr ret
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FnHandle args ret -> TypeRepr ret
handleReturnType FnHandle args ret
h)
              FnHandle args ret
h
              Position
p
           )
        | (SomeHandle FnHandle args ret
h,Position
p) <- [(SomeHandle, Position)]
builtIns
        ]

initSyntaxState :: NonceGenerator IO s -> ProgramState s -> SyntaxState s
initSyntaxState :: forall s. NonceGenerator IO s -> ProgramState s -> SyntaxState s
initSyntaxState =
  Map LabelName (LabelInfo s)
-> Map AtomName (Some (Atom s))
-> Map RegName (Some (Reg s))
-> NonceGenerator IO s
-> ProgramState s
-> SyntaxState s
forall s.
Map LabelName (LabelInfo s)
-> Map AtomName (Some (Atom s))
-> Map RegName (Some (Reg s))
-> NonceGenerator IO s
-> ProgramState s
-> SyntaxState s
SyntaxState Map LabelName (LabelInfo s)
forall k a. Map k a
Map.empty Map AtomName (Some (Atom s))
forall k a. Map k a
Map.empty Map RegName (Some (Reg s))
forall k a. Map k a
Map.empty

stxLabels :: Simple Lens (SyntaxState s) (Map LabelName (LabelInfo s))
stxLabels :: forall s (f :: * -> *).
Functor f =>
(Map LabelName (LabelInfo s) -> f (Map LabelName (LabelInfo s)))
-> SyntaxState s -> f (SyntaxState s)
stxLabels = (SyntaxState s -> Map LabelName (LabelInfo s))
-> (SyntaxState s -> Map LabelName (LabelInfo s) -> SyntaxState s)
-> Lens
     (SyntaxState s)
     (SyntaxState s)
     (Map LabelName (LabelInfo s))
     (Map LabelName (LabelInfo s))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SyntaxState s -> Map LabelName (LabelInfo s)
forall s. SyntaxState s -> Map LabelName (LabelInfo s)
_stxLabels (\SyntaxState s
s Map LabelName (LabelInfo s)
v -> SyntaxState s
s { _stxLabels = v })

stxAtoms :: Simple Lens (SyntaxState s) (Map AtomName (Some (Atom s)))
stxAtoms :: forall s (f :: * -> *).
Functor f =>
(Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
-> SyntaxState s -> f (SyntaxState s)
stxAtoms = (SyntaxState s -> Map AtomName (Some (Atom s)))
-> (SyntaxState s -> Map AtomName (Some (Atom s)) -> SyntaxState s)
-> Lens
     (SyntaxState s)
     (SyntaxState s)
     (Map AtomName (Some (Atom s)))
     (Map AtomName (Some (Atom s)))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SyntaxState s -> Map AtomName (Some (Atom s))
forall s. SyntaxState s -> Map AtomName (Some (Atom s))
_stxAtoms (\SyntaxState s
s Map AtomName (Some (Atom s))
v -> SyntaxState s
s { _stxAtoms = v })

stxRegisters :: Simple Lens (SyntaxState s) (Map RegName (Some (Reg s)))
stxRegisters :: forall s (f :: * -> *).
Functor f =>
(Map RegName (Some (Reg s)) -> f (Map RegName (Some (Reg s))))
-> SyntaxState s -> f (SyntaxState s)
stxRegisters = (SyntaxState s -> Map RegName (Some (Reg s)))
-> (SyntaxState s -> Map RegName (Some (Reg s)) -> SyntaxState s)
-> Lens
     (SyntaxState s)
     (SyntaxState s)
     (Map RegName (Some (Reg s)))
     (Map RegName (Some (Reg s)))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SyntaxState s -> Map RegName (Some (Reg s))
forall s. SyntaxState s -> Map RegName (Some (Reg s))
_stxRegisters (\SyntaxState s
s Map RegName (Some (Reg s))
v -> SyntaxState s
s { _stxRegisters = v })

stxNonceGen :: Getter (SyntaxState s) (NonceGenerator IO s)
stxNonceGen :: forall s (f :: * -> *).
(Contravariant f, Functor f) =>
(NonceGenerator IO s -> f (NonceGenerator IO s))
-> SyntaxState s -> f (SyntaxState s)
stxNonceGen = (SyntaxState s -> NonceGenerator IO s)
-> (NonceGenerator IO s -> f (NonceGenerator IO s))
-> SyntaxState s
-> f (SyntaxState s)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SyntaxState s -> NonceGenerator IO s
forall s. SyntaxState s -> NonceGenerator IO s
_stxNonceGen

stxProgState :: Simple Lens (SyntaxState s) (ProgramState s)
stxProgState :: forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState = (SyntaxState s -> ProgramState s)
-> (SyntaxState s -> ProgramState s -> SyntaxState s)
-> Lens
     (SyntaxState s) (SyntaxState s) (ProgramState s) (ProgramState s)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SyntaxState s -> ProgramState s
forall s. SyntaxState s -> ProgramState s
_stxProgState (\SyntaxState s
s ProgramState s
v -> SyntaxState s
s { _stxProgState = v })

stxFunctions :: Simple Lens (SyntaxState s) (Map FunctionName FunctionHeader)
stxFunctions :: forall s (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> SyntaxState s -> f (SyntaxState s)
stxFunctions = (ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState ((ProgramState s -> f (ProgramState s))
 -> SyntaxState s -> f (SyntaxState s))
-> ((Map FunctionName FunctionHeader
     -> f (Map FunctionName FunctionHeader))
    -> ProgramState s -> f (ProgramState s))
-> (Map FunctionName FunctionHeader
    -> f (Map FunctionName FunctionHeader))
-> SyntaxState s
-> f (SyntaxState s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> ProgramState s -> f (ProgramState s)
forall {k} (s :: k) (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> ProgramState s -> f (ProgramState s)
progFunctions

stxForwardDecs :: Simple Lens (SyntaxState s) (Map FunctionName FunctionHeader)
stxForwardDecs :: forall s (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> SyntaxState s -> f (SyntaxState s)
stxForwardDecs = (ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState ((ProgramState s -> f (ProgramState s))
 -> SyntaxState s -> f (SyntaxState s))
-> ((Map FunctionName FunctionHeader
     -> f (Map FunctionName FunctionHeader))
    -> ProgramState s -> f (ProgramState s))
-> (Map FunctionName FunctionHeader
    -> f (Map FunctionName FunctionHeader))
-> SyntaxState s
-> f (SyntaxState s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> ProgramState s -> f (ProgramState s)
forall {k} (s :: k) (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> ProgramState s -> f (ProgramState s)
progForwardDecs

stxGlobals :: Simple Lens (SyntaxState s) (Map GlobalName (Some GlobalVar))
stxGlobals :: forall s (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> f (SyntaxState s)
stxGlobals = (ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState ((ProgramState s -> f (ProgramState s))
 -> SyntaxState s -> f (SyntaxState s))
-> ((Map GlobalName (Some GlobalVar)
     -> f (Map GlobalName (Some GlobalVar)))
    -> ProgramState s -> f (ProgramState s))
-> (Map GlobalName (Some GlobalVar)
    -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s
-> f (SyntaxState s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> ProgramState s -> f (ProgramState s)
forall {k} (s :: k) (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> ProgramState s -> f (ProgramState s)
progGlobals

stxExterns :: Simple Lens (SyntaxState s) (Map GlobalName (Some GlobalVar))
stxExterns :: forall s (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> f (SyntaxState s)
stxExterns = (ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState ((ProgramState s -> f (ProgramState s))
 -> SyntaxState s -> f (SyntaxState s))
-> ((Map GlobalName (Some GlobalVar)
     -> f (Map GlobalName (Some GlobalVar)))
    -> ProgramState s -> f (ProgramState s))
-> (Map GlobalName (Some GlobalVar)
    -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s
-> f (SyntaxState s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> ProgramState s -> f (ProgramState s)
forall {k} (s :: k) (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> ProgramState s -> f (ProgramState s)
progExterns

newtype CFGParser s ret a =
  CFGParser { forall s (ret :: CrucibleType) a.
CFGParser s ret a
-> (?returnType::TypeRepr ret) =>
   ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
runCFGParser :: (?returnType :: TypeRepr ret)
                           => ExceptT (ExprErr s)
                                (StateT (SyntaxState s) IO)
                                a
            }
  deriving ((forall a b. (a -> b) -> CFGParser s ret a -> CFGParser s ret b)
-> (forall a b. a -> CFGParser s ret b -> CFGParser s ret a)
-> Functor (CFGParser s ret)
forall a b. a -> CFGParser s ret b -> CFGParser s ret a
forall a b. (a -> b) -> CFGParser s ret a -> CFGParser s ret b
forall s (ret :: CrucibleType) a b.
a -> CFGParser s ret b -> CFGParser s ret a
forall s (ret :: CrucibleType) a b.
(a -> b) -> CFGParser s ret a -> CFGParser s ret b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s (ret :: CrucibleType) a b.
(a -> b) -> CFGParser s ret a -> CFGParser s ret b
fmap :: forall a b. (a -> b) -> CFGParser s ret a -> CFGParser s ret b
$c<$ :: forall s (ret :: CrucibleType) a b.
a -> CFGParser s ret b -> CFGParser s ret a
<$ :: forall a b. a -> CFGParser s ret b -> CFGParser s ret a
Functor)

instance Applicative (CFGParser s ret) where
  pure :: forall a. a -> CFGParser s ret a
pure a
x = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser (a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a. a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  (CFGParser (?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (a -> b)
f) <*> :: forall a b.
CFGParser s ret (a -> b) -> CFGParser s ret a -> CFGParser s ret b
<*> (CFGParser (?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
x) = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b)
-> CFGParser s ret b
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (a -> b)
(?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (a -> b)
f ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (a -> b)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall a b.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (a -> b)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
(?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
x)

instance Alternative (CFGParser s ret) where
  empty :: forall a. CFGParser s ret a
empty = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser (((?returnType::TypeRepr ret) =>
  ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
 -> CFGParser s ret a)
-> ((?returnType::TypeRepr ret) =>
    ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall a b. (a -> b) -> a -> b
$ ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a.
ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a b. (a -> b) -> a -> b
$ Position -> ExprErr s
forall {k} (s :: k). Position -> ExprErr s
TrivialErr Position
InternalPos
  (CFGParser (?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
x) <|> :: forall a.
CFGParser s ret a -> CFGParser s ret a -> CFGParser s ret a
<|> (CFGParser (?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
y) = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
(?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
x ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
(?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
y)

instance Semigroup (CFGParser s ret a) where
  <> :: CFGParser s ret a -> CFGParser s ret a -> CFGParser s ret a
(<>) = CFGParser s ret a -> CFGParser s ret a -> CFGParser s ret a
forall a.
CFGParser s ret a -> CFGParser s ret a -> CFGParser s ret a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Monoid (CFGParser s ret a) where
  mempty :: CFGParser s ret a
mempty = CFGParser s ret a
forall a. CFGParser s ret a
forall (f :: * -> *) a. Alternative f => f a
empty

instance Monad (CFGParser s ret) where
  (CFGParser (?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
m) >>= :: forall a b.
CFGParser s ret a -> (a -> CFGParser s ret b) -> CFGParser s ret b
>>= a -> CFGParser s ret b
f = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b)
-> CFGParser s ret b
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser (((?returnType::TypeRepr ret) =>
  ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b)
 -> CFGParser s ret b)
-> ((?returnType::TypeRepr ret) =>
    ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b)
-> CFGParser s ret b
forall a b. (a -> b) -> a -> b
$ ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
(?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
m ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> (a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall a b.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> (a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> CFGParser s ret b
-> (?returnType::TypeRepr ret) =>
   ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall s (ret :: CrucibleType) a.
CFGParser s ret a
-> (?returnType::TypeRepr ret) =>
   ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
runCFGParser (a -> CFGParser s ret b
f a
a)

instance MonadError (ExprErr s) (CFGParser s ret) where
  throwError :: forall a. ExprErr s -> CFGParser s ret a
throwError ExprErr s
e = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser (((?returnType::TypeRepr ret) =>
  ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
 -> CFGParser s ret a)
-> ((?returnType::TypeRepr ret) =>
    ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall a b. (a -> b) -> a -> b
$ ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a.
ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ExprErr s
e
  catchError :: forall a.
CFGParser s ret a
-> (ExprErr s -> CFGParser s ret a) -> CFGParser s ret a
catchError CFGParser s ret a
m ExprErr s -> CFGParser s ret a
h = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser (((?returnType::TypeRepr ret) =>
  ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
 -> CFGParser s ret a)
-> ((?returnType::TypeRepr ret) =>
    ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall a b. (a -> b) -> a -> b
$ ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> (ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> (ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (CFGParser s ret a
-> (?returnType::TypeRepr ret) =>
   ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall s (ret :: CrucibleType) a.
CFGParser s ret a
-> (?returnType::TypeRepr ret) =>
   ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
runCFGParser CFGParser s ret a
m) (\ExprErr s
e -> CFGParser s ret a
-> (?returnType::TypeRepr ret) =>
   ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall s (ret :: CrucibleType) a.
CFGParser s ret a
-> (?returnType::TypeRepr ret) =>
   ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
runCFGParser (CFGParser s ret a
 -> (?returnType::TypeRepr ret) =>
    ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
-> (?returnType::TypeRepr ret) =>
   ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a b. (a -> b) -> a -> b
$ ExprErr s -> CFGParser s ret a
h ExprErr s
e)

instance MonadState (SyntaxState s) (CFGParser s ret) where
  get :: CFGParser s ret (SyntaxState s)
get = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (SyntaxState s))
-> CFGParser s ret (SyntaxState s)
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (SyntaxState s)
(?returnType::TypeRepr ret) =>
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (SyntaxState s)
forall s (m :: * -> *). MonadState s m => m s
get
  put :: SyntaxState s -> CFGParser s ret ()
put SyntaxState s
s = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) ())
-> CFGParser s ret ()
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser (((?returnType::TypeRepr ret) =>
  ExceptT (ExprErr s) (StateT (SyntaxState s) IO) ())
 -> CFGParser s ret ())
-> ((?returnType::TypeRepr ret) =>
    ExceptT (ExprErr s) (StateT (SyntaxState s) IO) ())
-> CFGParser s ret ()
forall a b. (a -> b) -> a -> b
$ SyntaxState s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put SyntaxState s
s

instance MonadIO (CFGParser s ret) where
  liftIO :: forall a. IO a -> CFGParser s ret a
liftIO IO a
io = ((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall s (ret :: CrucibleType) a.
((?returnType::TypeRepr ret) =>
 ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
CFGParser (((?returnType::TypeRepr ret) =>
  ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
 -> CFGParser s ret a)
-> ((?returnType::TypeRepr ret) =>
    ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> CFGParser s ret a
forall a b. (a -> b) -> a -> b
$ StateT (SyntaxState s) IO a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall (m :: * -> *) a. Monad m => m a -> ExceptT (ExprErr s) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (SyntaxState s) IO a
 -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> StateT (SyntaxState s) IO a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a b. (a -> b) -> a -> b
$ IO a -> StateT (SyntaxState s) IO a
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (SyntaxState s) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO a
io


freshId :: (MonadState (SyntaxState s) m, MonadIO m) => m (Nonce s tp)
freshId :: forall {k} s (m :: * -> *) (tp :: k).
(MonadState (SyntaxState s) m, MonadIO m) =>
m (Nonce s tp)
freshId =
  do NonceGenerator IO s
ng <- Getting (NonceGenerator IO s) (SyntaxState s) (NonceGenerator IO s)
-> m (NonceGenerator IO s)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (NonceGenerator IO s) (SyntaxState s) (NonceGenerator IO s)
forall s (f :: * -> *).
(Contravariant f, Functor f) =>
(NonceGenerator IO s -> f (NonceGenerator IO s))
-> SyntaxState s -> f (SyntaxState s)
stxNonceGen
     IO (Nonce s tp) -> m (Nonce s tp)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Nonce s tp) -> m (Nonce s tp))
-> IO (Nonce s tp) -> m (Nonce s tp)
forall a b. (a -> b) -> a -> b
$ NonceGenerator IO s -> IO (Nonce s tp)
forall (m :: * -> *) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce NonceGenerator IO s
ng

freshLabel :: (MonadState (SyntaxState s) m, MonadIO m) => m (Label s)
freshLabel :: forall s (m :: * -> *).
(MonadState (SyntaxState s) m, MonadIO m) =>
m (Label s)
freshLabel = Nonce s 'UnitType -> Label s
forall s. Nonce s 'UnitType -> Label s
Label (Nonce s 'UnitType -> Label s)
-> m (Nonce s 'UnitType) -> m (Label s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Nonce s 'UnitType)
forall {k} s (m :: * -> *) (tp :: k).
(MonadState (SyntaxState s) m, MonadIO m) =>
m (Nonce s tp)
freshId

freshAtom :: ( MonadWriter [Posd (Stmt ext s)] m
             , MonadState (SyntaxState s) m
             , MonadIO m
             , IsSyntaxExtension ext )
          => Position -> AtomValue ext s t -> m (Atom s t)
freshAtom :: forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc AtomValue ext s t
v =
  do Nonce s t
i <- m (Nonce s t)
forall {k} s (m :: * -> *) (tp :: k).
(MonadState (SyntaxState s) m, MonadIO m) =>
m (Nonce s tp)
freshId
     let theAtom :: Atom s t
theAtom = Atom { atomPosition :: Position
atomPosition = Text -> Position
OtherPos Text
"Parser internals"
                        , atomId :: Nonce s t
atomId = Nonce s t
i
                        , atomSource :: AtomSource s t
atomSource = AtomSource s t
forall s (tp :: CrucibleType). AtomSource s tp
Assigned
                        , typeOfAtom :: TypeRepr t
typeOfAtom = AtomValue ext s t -> TypeRepr t
forall ext s (tp :: CrucibleType).
(TypeApp (StmtExtension ext), TypeApp (ExprExtension ext)) =>
AtomValue ext s tp -> TypeRepr tp
typeOfAtomValue AtomValue ext s t
v
                        }
         stmt :: Stmt ext s
stmt = Atom s t -> AtomValue ext s t -> Stmt ext s
forall ext s (tp :: CrucibleType).
Atom s tp -> AtomValue ext s tp -> Stmt ext s
DefineAtom Atom s t
theAtom AtomValue ext s t
v
     [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
loc Stmt ext s
stmt]
     Atom s t -> m (Atom s t)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom s t
theAtom



newLabel :: (MonadState (SyntaxState s) m, MonadIO m) => LabelName -> m (Label s)
newLabel :: forall s (m :: * -> *).
(MonadState (SyntaxState s) m, MonadIO m) =>
LabelName -> m (Label s)
newLabel LabelName
x =
  do Label s
theLbl <- m (Label s)
forall s (m :: * -> *).
(MonadState (SyntaxState s) m, MonadIO m) =>
m (Label s)
freshLabel
     (Map LabelName (LabelInfo s)
 -> Identity (Map LabelName (LabelInfo s)))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map LabelName (LabelInfo s) -> f (Map LabelName (LabelInfo s)))
-> SyntaxState s -> f (SyntaxState s)
stxLabels ((Map LabelName (LabelInfo s)
  -> Identity (Map LabelName (LabelInfo s)))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map LabelName (LabelInfo s) -> Map LabelName (LabelInfo s))
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= LabelName
-> LabelInfo s
-> Map LabelName (LabelInfo s)
-> Map LabelName (LabelInfo s)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert LabelName
x (Label s -> LabelInfo s
forall s. Label s -> LabelInfo s
NoArgLbl Label s
theLbl)
     Label s -> m (Label s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Label s
theLbl

freshLambdaLabel :: (MonadState (SyntaxState s) m, MonadIO m) => TypeRepr tp -> m (LambdaLabel s tp, Atom s tp)
freshLambdaLabel :: forall s (m :: * -> *) (tp :: CrucibleType).
(MonadState (SyntaxState s) m, MonadIO m) =>
TypeRepr tp -> m (LambdaLabel s tp, Atom s tp)
freshLambdaLabel TypeRepr tp
t =
  do Nonce s tp
n <- m (Nonce s tp)
forall {k} s (m :: * -> *) (tp :: k).
(MonadState (SyntaxState s) m, MonadIO m) =>
m (Nonce s tp)
freshId
     Nonce s tp
i <- m (Nonce s tp)
forall {k} s (m :: * -> *) (tp :: k).
(MonadState (SyntaxState s) m, MonadIO m) =>
m (Nonce s tp)
freshId
     let lbl :: LambdaLabel s tp
lbl = Nonce s tp -> Atom s tp -> LambdaLabel s tp
forall s (tp :: CrucibleType).
Nonce s tp -> Atom s tp -> LambdaLabel s tp
LambdaLabel Nonce s tp
n Atom s tp
a
         a :: Atom s tp
a   = Atom { atomPosition :: Position
atomPosition = Text -> Position
OtherPos Text
"Parser internals"
                    , atomId :: Nonce s tp
atomId = Nonce s tp
i
                    , atomSource :: AtomSource s tp
atomSource = LambdaLabel s tp -> AtomSource s tp
forall s (tp :: CrucibleType). LambdaLabel s tp -> AtomSource s tp
LambdaArg LambdaLabel s tp
lbl
                    , typeOfAtom :: TypeRepr tp
typeOfAtom = TypeRepr tp
t
                    }
     (LambdaLabel s tp, Atom s tp) -> m (LambdaLabel s tp, Atom s tp)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LambdaLabel s tp
lbl, Atom s tp
a)

with :: MonadState s m => Lens' s a -> (a -> m b) -> m b
with :: forall s (m :: * -> *) a b.
MonadState s m =>
Lens' s a -> (a -> m b) -> m b
with Lens' s a
l a -> m b
act = do a
x <- Getting a s a -> m a
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting a s a
Lens' s a
l; a -> m b
act a
x


lambdaLabelBinding :: ( MonadSyntax Atomic m
                      , MonadState (SyntaxState s) m
                      , MonadIO m
                      , ?parserHooks :: ParserHooks ext )
                   => m (LabelName, Some (LambdaLabel s))
lambdaLabelBinding :: forall (m :: * -> *) s ext.
(MonadSyntax Atomic m, MonadState (SyntaxState s) m, MonadIO m,
 ?parserHooks::ParserHooks ext) =>
m (LabelName, Some (LambdaLabel s))
lambdaLabelBinding =
  m (LabelName, Some (LambdaLabel s))
-> m (LabelName, Some (LambdaLabel s))
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (m (LabelName, Some (LambdaLabel s))
 -> m (LabelName, Some (LambdaLabel s)))
-> m (LabelName, Some (LambdaLabel s))
-> m (LabelName, Some (LambdaLabel s))
forall a b. (a -> b) -> a -> b
$
  m LabelName
-> (LabelName -> m (LabelName, Some (LambdaLabel s)))
-> m (LabelName, Some (LambdaLabel s))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m LabelName
uniqueLabel ((LabelName -> m (LabelName, Some (LambdaLabel s)))
 -> m (LabelName, Some (LambdaLabel s)))
-> (LabelName -> m (LabelName, Some (LambdaLabel s)))
-> m (LabelName, Some (LambdaLabel s))
forall a b. (a -> b) -> a -> b
$
  \LabelName
l ->
    m AtomName
-> (AtomName -> m (LabelName, Some (LambdaLabel s)))
-> m (LabelName, Some (LambdaLabel s))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m AtomName
forall (m :: * -> *) s.
(MonadSyntax Atomic m, MonadState (SyntaxState s) m) =>
m AtomName
uniqueAtom ((AtomName -> m (LabelName, Some (LambdaLabel s)))
 -> m (LabelName, Some (LambdaLabel s)))
-> (AtomName -> m (LabelName, Some (LambdaLabel s)))
-> m (LabelName, Some (LambdaLabel s))
forall a b. (a -> b) -> a -> b
$
    \AtomName
x ->
      m (Some TypeRepr)
-> (Some TypeRepr -> m (LabelName, Some (LambdaLabel s)))
-> m (LabelName, Some (LambdaLabel s))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType ((Some TypeRepr -> m (LabelName, Some (LambdaLabel s)))
 -> m (LabelName, Some (LambdaLabel s)))
-> (Some TypeRepr -> m (LabelName, Some (LambdaLabel s)))
-> m (LabelName, Some (LambdaLabel s))
forall a b. (a -> b) -> a -> b
$
      \(Some TypeRepr x
t) ->
        do (LambdaLabel s x
lbl, Atom s x
anAtom) <- TypeRepr x -> m (LambdaLabel s x, Atom s x)
forall s (m :: * -> *) (tp :: CrucibleType).
(MonadState (SyntaxState s) m, MonadIO m) =>
TypeRepr tp -> m (LambdaLabel s tp, Atom s tp)
freshLambdaLabel TypeRepr x
t
           (Map LabelName (LabelInfo s)
 -> Identity (Map LabelName (LabelInfo s)))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map LabelName (LabelInfo s) -> f (Map LabelName (LabelInfo s)))
-> SyntaxState s -> f (SyntaxState s)
stxLabels ((Map LabelName (LabelInfo s)
  -> Identity (Map LabelName (LabelInfo s)))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map LabelName (LabelInfo s) -> Map LabelName (LabelInfo s))
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= LabelName
-> LabelInfo s
-> Map LabelName (LabelInfo s)
-> Map LabelName (LabelInfo s)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert LabelName
l (LambdaLabel s x -> LabelInfo s
forall s (ty :: CrucibleType). LambdaLabel s ty -> LabelInfo s
ArgLbl LambdaLabel s x
lbl)
           (Map AtomName (Some (Atom s))
 -> Identity (Map AtomName (Some (Atom s))))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
-> SyntaxState s -> f (SyntaxState s)
stxAtoms ((Map AtomName (Some (Atom s))
  -> Identity (Map AtomName (Some (Atom s))))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map AtomName (Some (Atom s)) -> Map AtomName (Some (Atom s)))
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= AtomName
-> Some (Atom s)
-> Map AtomName (Some (Atom s))
-> Map AtomName (Some (Atom s))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AtomName
x (Atom s x -> Some (Atom s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Atom s x
anAtom)
           (LabelName, Some (LambdaLabel s))
-> m (LabelName, Some (LambdaLabel s))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelName
l, LambdaLabel s x -> Some (LambdaLabel s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some LambdaLabel s x
lbl)

  where uniqueLabel :: m LabelName
uniqueLabel =
          do Map LabelName (LabelInfo s)
labels <- Getting
  (Map LabelName (LabelInfo s))
  (SyntaxState s)
  (Map LabelName (LabelInfo s))
-> m (Map LabelName (LabelInfo s))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map LabelName (LabelInfo s))
  (SyntaxState s)
  (Map LabelName (LabelInfo s))
forall s (f :: * -> *).
Functor f =>
(Map LabelName (LabelInfo s) -> f (Map LabelName (LabelInfo s)))
-> SyntaxState s -> f (SyntaxState s)
stxLabels
             Text
-> (LabelName -> Maybe LabelName) -> m LabelName -> m LabelName
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"unique label"
               (\LabelName
l -> case LabelName -> Map LabelName (LabelInfo s) -> Maybe (LabelInfo s)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup LabelName
l Map LabelName (LabelInfo s)
labels of
                        Maybe (LabelInfo s)
Nothing -> LabelName -> Maybe LabelName
forall a. a -> Maybe a
Just LabelName
l
                        Just LabelInfo s
_ -> Maybe LabelName
forall a. Maybe a
Nothing)
               m LabelName
forall (m :: * -> *). MonadSyntax Atomic m => m LabelName
labelName


uniqueAtom :: (MonadSyntax Atomic m, MonadState (SyntaxState s) m) => m AtomName
uniqueAtom :: forall (m :: * -> *) s.
(MonadSyntax Atomic m, MonadState (SyntaxState s) m) =>
m AtomName
uniqueAtom =
  do Map AtomName (Some (Atom s))
atoms <- Getting
  (Map AtomName (Some (Atom s)))
  (SyntaxState s)
  (Map AtomName (Some (Atom s)))
-> m (Map AtomName (Some (Atom s)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map AtomName (Some (Atom s)))
  (SyntaxState s)
  (Map AtomName (Some (Atom s)))
forall s (f :: * -> *).
Functor f =>
(Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
-> SyntaxState s -> f (SyntaxState s)
stxAtoms
     Text -> (AtomName -> Maybe AtomName) -> m AtomName -> m AtomName
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
Text -> (a -> Maybe b) -> m a -> m b
sideCondition Text
"unique Crucible atom"
       (\AtomName
x -> case AtomName -> Map AtomName (Some (Atom s)) -> Maybe (Some (Atom s))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup AtomName
x Map AtomName (Some (Atom s))
atoms of
                Maybe (Some (Atom s))
Nothing -> AtomName -> Maybe AtomName
forall a. a -> Maybe a
Just AtomName
x
                Just Some (Atom s)
_ -> Maybe AtomName
forall a. Maybe a
Nothing)
       m AtomName
forall (m :: * -> *). MonadSyntax Atomic m => m AtomName
atomName

newUnassignedReg :: (MonadState (SyntaxState s) m, MonadIO m) => TypeRepr t -> m (Reg s t)
newUnassignedReg :: forall s (m :: * -> *) (t :: CrucibleType).
(MonadState (SyntaxState s) m, MonadIO m) =>
TypeRepr t -> m (Reg s t)
newUnassignedReg TypeRepr t
t =
  do Nonce s t
i <- m (Nonce s t)
forall {k} s (m :: * -> *) (tp :: k).
(MonadState (SyntaxState s) m, MonadIO m) =>
m (Nonce s tp)
freshId
     let fakePos :: Position
fakePos = Text -> Position
OtherPos Text
"Parser internals"
     Reg s t -> m (Reg s t)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg s t -> m (Reg s t)) -> Reg s t -> m (Reg s t)
forall a b. (a -> b) -> a -> b
$! Reg { regPosition :: Position
regPosition = Position
fakePos
                   , regId :: Nonce s t
regId = Nonce s t
i
                   , typeOfReg :: TypeRepr t
typeOfReg = TypeRepr t
t
                   }

regRef' :: (MonadSyntax Atomic m, MonadReader (SyntaxState s) m) => m (Some (Reg s))
regRef' :: forall (m :: * -> *) s.
(MonadSyntax Atomic m, MonadReader (SyntaxState s) m) =>
m (Some (Reg s))
regRef' =
  Text -> m (Some (Reg s)) -> m (Some (Reg s))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"known register name" (m (Some (Reg s)) -> m (Some (Reg s)))
-> m (Some (Reg s)) -> m (Some (Reg s))
forall a b. (a -> b) -> a -> b
$
  do RegName
rn <- m RegName
forall (m :: * -> *). MonadSyntax Atomic m => m RegName
regName
     Maybe (Some (Reg s))
perhapsReg <- Getting
  (Maybe (Some (Reg s))) (SyntaxState s) (Maybe (Some (Reg s)))
-> m (Maybe (Some (Reg s)))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Map RegName (Some (Reg s))
 -> Const (Maybe (Some (Reg s))) (Map RegName (Some (Reg s))))
-> SyntaxState s -> Const (Maybe (Some (Reg s))) (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map RegName (Some (Reg s)) -> f (Map RegName (Some (Reg s))))
-> SyntaxState s -> f (SyntaxState s)
stxRegisters ((Map RegName (Some (Reg s))
  -> Const (Maybe (Some (Reg s))) (Map RegName (Some (Reg s))))
 -> SyntaxState s -> Const (Maybe (Some (Reg s))) (SyntaxState s))
-> ((Maybe (Some (Reg s))
     -> Const (Maybe (Some (Reg s))) (Maybe (Some (Reg s))))
    -> Map RegName (Some (Reg s))
    -> Const (Maybe (Some (Reg s))) (Map RegName (Some (Reg s))))
-> Getting
     (Maybe (Some (Reg s))) (SyntaxState s) (Maybe (Some (Reg s)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map RegName (Some (Reg s)))
-> Lens'
     (Map RegName (Some (Reg s)))
     (Maybe (IxValue (Map RegName (Some (Reg s)))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map RegName (Some (Reg s)))
RegName
rn)
     case Maybe (Some (Reg s))
perhapsReg of
       Just Some (Reg s)
reg -> Some (Reg s) -> m (Some (Reg s))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Some (Reg s)
reg
       Maybe (Some (Reg s))
Nothing -> m (Some (Reg s))
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

globRef' :: (MonadSyntax Atomic m, MonadReader (SyntaxState s) m) => m (Some GlobalVar)
globRef' :: forall (m :: * -> *) s.
(MonadSyntax Atomic m, MonadReader (SyntaxState s) m) =>
m (Some GlobalVar)
globRef' =
  Text -> m (Some GlobalVar) -> m (Some GlobalVar)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"known global variable name" (m (Some GlobalVar) -> m (Some GlobalVar))
-> m (Some GlobalVar) -> m (Some GlobalVar)
forall a b. (a -> b) -> a -> b
$
  do GlobalName
x <- m GlobalName
forall (m :: * -> *). MonadSyntax Atomic m => m GlobalName
globalName
     Maybe (Some GlobalVar)
perhapsGlobal <- Getting
  (Maybe (Some GlobalVar)) (SyntaxState s) (Maybe (Some GlobalVar))
-> m (Maybe (Some GlobalVar))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Map GlobalName (Some GlobalVar)
 -> Const
      (Maybe (Some GlobalVar)) (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> Const (Maybe (Some GlobalVar)) (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> f (SyntaxState s)
stxGlobals ((Map GlobalName (Some GlobalVar)
  -> Const
       (Maybe (Some GlobalVar)) (Map GlobalName (Some GlobalVar)))
 -> SyntaxState s -> Const (Maybe (Some GlobalVar)) (SyntaxState s))
-> ((Maybe (Some GlobalVar)
     -> Const (Maybe (Some GlobalVar)) (Maybe (Some GlobalVar)))
    -> Map GlobalName (Some GlobalVar)
    -> Const
         (Maybe (Some GlobalVar)) (Map GlobalName (Some GlobalVar)))
-> Getting
     (Maybe (Some GlobalVar)) (SyntaxState s) (Maybe (Some GlobalVar))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map GlobalName (Some GlobalVar))
-> Lens'
     (Map GlobalName (Some GlobalVar))
     (Maybe (IxValue (Map GlobalName (Some GlobalVar))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map GlobalName (Some GlobalVar))
GlobalName
x)
     Maybe (Some GlobalVar)
perhapsExtern <- Getting
  (Maybe (Some GlobalVar)) (SyntaxState s) (Maybe (Some GlobalVar))
-> m (Maybe (Some GlobalVar))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Map GlobalName (Some GlobalVar)
 -> Const
      (Maybe (Some GlobalVar)) (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> Const (Maybe (Some GlobalVar)) (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> f (SyntaxState s)
stxExterns ((Map GlobalName (Some GlobalVar)
  -> Const
       (Maybe (Some GlobalVar)) (Map GlobalName (Some GlobalVar)))
 -> SyntaxState s -> Const (Maybe (Some GlobalVar)) (SyntaxState s))
-> ((Maybe (Some GlobalVar)
     -> Const (Maybe (Some GlobalVar)) (Maybe (Some GlobalVar)))
    -> Map GlobalName (Some GlobalVar)
    -> Const
         (Maybe (Some GlobalVar)) (Map GlobalName (Some GlobalVar)))
-> Getting
     (Maybe (Some GlobalVar)) (SyntaxState s) (Maybe (Some GlobalVar))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map GlobalName (Some GlobalVar))
-> Lens'
     (Map GlobalName (Some GlobalVar))
     (Maybe (IxValue (Map GlobalName (Some GlobalVar))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map GlobalName (Some GlobalVar))
GlobalName
x)
     case Maybe (Some GlobalVar)
perhapsGlobal Maybe (Some GlobalVar)
-> Maybe (Some GlobalVar) -> Maybe (Some GlobalVar)
forall {a}. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Some GlobalVar)
perhapsExtern of
       Just Some GlobalVar
glob -> Some GlobalVar -> m (Some GlobalVar)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Some GlobalVar
glob
       Maybe (Some GlobalVar)
Nothing -> m (Some GlobalVar)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty



reading :: MonadState r m => ReaderT r m b -> m b
reading :: forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading ReaderT r m b
m = m r
forall s (m :: * -> *). MonadState s m => m s
get m r -> (r -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m b
m

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

atomSetter :: forall m ext s
            . ( MonadSyntax Atomic m
              , MonadWriter [Posd (Stmt ext s)] m
              , MonadState (SyntaxState s) m
              , MonadIO m
              , IsSyntaxExtension ext
              , ?parserHooks :: ParserHooks ext )
           => AtomName -- ^ The name of the atom being set, used for fresh name internals
           -> m (Some (Atom s))
atomSetter :: forall (m :: * -> *) ext s.
(MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
AtomName -> m (Some (Atom s))
atomSetter (AtomName Text
anText) =
  m (Some (Atom s)) -> m (Some (Atom s))
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call ( m (Some (Atom s))
(MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext) =>
m (Some (Atom s))
newref
     m (Some (Atom s)) -> m (Some (Atom s)) -> m (Some (Atom s))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some (Atom s))
(MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext) =>
m (Some (Atom s))
emptyref
     m (Some (Atom s)) -> m (Some (Atom s)) -> m (Some (Atom s))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some (Atom s))
(MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext) =>
m (Some (Atom s))
fresh
     m (Some (Atom s)) -> m (Some (Atom s)) -> m (Some (Atom s))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some (Atom s))
forall ext s (m :: * -> *).
(MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
m (Some (Atom s))
funcall
     m (Some (Atom s)) -> m (Some (Atom s)) -> m (Some (Atom s))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (Some (Atom s))
evaluated
     m (Some (Atom s)) -> m (Some (Atom s)) -> m (Some (Atom s))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParserHooks ext
-> forall s (m :: * -> *).
   (MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
    MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
    ?parserHooks::ParserHooks ext) =>
   m (Some (Atom s))
forall ext.
ParserHooks ext
-> forall s (m :: * -> *).
   (MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
    MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
    ?parserHooks::ParserHooks ext) =>
   m (Some (Atom s))
extensionParser ?parserHooks::ParserHooks ext
ParserHooks ext
?parserHooks) )
  where
    fresh, emptyref, newref
      :: ( MonadSyntax Atomic m
         , MonadWriter [Posd (Stmt ext s)] m
         , MonadState (SyntaxState s) m
         , MonadIO m
         , IsSyntaxExtension ext
         )
      => m (Some (Atom s))

    newref :: (MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext) =>
m (Some (Atom s))
newref =
      do Pair TypeRepr tp
_ E ext s tp
e <- ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
 -> m (Pair TypeRepr (E ext s)))
-> ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall a b. (a -> b) -> a -> b
$ Keyword
-> ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Ref ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
         Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
         Atom s tp
anAtom <- Position -> E ext s tp -> m (Atom s tp)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s tp
e
         Atom s ('ReferenceType tp)
anotherAtom <- Position
-> AtomValue ext s ('ReferenceType tp)
-> m (Atom s ('ReferenceType tp))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (Atom s tp -> AtomValue ext s ('ReferenceType tp)
forall s (tp1 :: CrucibleType) ext.
Atom s tp1 -> AtomValue ext s ('ReferenceType tp1)
NewRef Atom s tp
anAtom)
         Some (Atom s) -> m (Some (Atom s))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Some (Atom s) -> m (Some (Atom s)))
-> Some (Atom s) -> m (Some (Atom s))
forall a b. (a -> b) -> a -> b
$ Atom s ('ReferenceType tp) -> Some (Atom s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Atom s ('ReferenceType tp)
anotherAtom

    emptyref :: (MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext) =>
m (Some (Atom s))
emptyref =
      do Some TypeRepr x
t' <- ReaderT (SyntaxState s) m (Some TypeRepr) -> m (Some TypeRepr)
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT (SyntaxState s) m (Some TypeRepr) -> m (Some TypeRepr))
-> ReaderT (SyntaxState s) m (Some TypeRepr) -> m (Some TypeRepr)
forall a b. (a -> b) -> a -> b
$ Keyword
-> ReaderT (SyntaxState s) m (Some TypeRepr)
-> ReaderT (SyntaxState s) m (Some TypeRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
EmptyRef ReaderT (SyntaxState s) m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType
         Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
         Atom s ('ReferenceType x)
anAtom <- Position
-> AtomValue ext s ('ReferenceType x)
-> m (Atom s ('ReferenceType x))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (TypeRepr x -> AtomValue ext s ('ReferenceType x)
forall (tp1 :: CrucibleType) ext s.
TypeRepr tp1 -> AtomValue ext s ('ReferenceType tp1)
NewEmptyRef TypeRepr x
t')
         Some (Atom s) -> m (Some (Atom s))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Some (Atom s) -> m (Some (Atom s)))
-> Some (Atom s) -> m (Some (Atom s))
forall a b. (a -> b) -> a -> b
$ Atom s ('ReferenceType x) -> Some (Atom s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Atom s ('ReferenceType x)
anAtom

    fresh :: (MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext) =>
m (Some (Atom s))
fresh =
      do Some TypeRepr
t <- ReaderT (SyntaxState s) m (Some TypeRepr) -> m (Some TypeRepr)
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (Keyword
-> ReaderT (SyntaxState s) m (Some TypeRepr)
-> ReaderT (SyntaxState s) m (Some TypeRepr)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Fresh ReaderT (SyntaxState s) m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType)
         -- Note that we are using safeSymbol below to create a What4 symbol
         -- name, which will Z-encode names that aren't legal solver names. This
         -- includes names that include hyphens, which are very common in
         -- S-expression syntax. This is fine to do, since the Z-encoded name
         -- name is only used for solver purposes; the original, unencoded name
         -- is recorded separately.
         let nm :: SolverSymbol
nm = String -> SolverSymbol
safeSymbol (Text -> String
T.unpack Text
anText)
         Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
         case Some TypeRepr
t of
           Some (FloatRepr FloatInfoRepr flt
fi) ->
             Atom s ('FloatType flt) -> Some (Atom s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Atom s ('FloatType flt) -> Some (Atom s))
-> m (Atom s ('FloatType flt)) -> m (Some (Atom s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               Position
-> AtomValue ext s ('FloatType flt) -> m (Atom s ('FloatType flt))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (FloatInfoRepr flt
-> Maybe SolverSymbol -> AtomValue ext s ('FloatType flt)
forall (fi :: FloatInfo) ext s.
FloatInfoRepr fi
-> Maybe SolverSymbol -> AtomValue ext s ('FloatType fi)
FreshFloat FloatInfoRepr flt
fi (SolverSymbol -> Maybe SolverSymbol
forall a. a -> Maybe a
Just SolverSymbol
nm))
           Some TypeRepr x
NatRepr ->
             Atom s 'NatType -> Some (Atom s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Atom s 'NatType -> Some (Atom s))
-> m (Atom s 'NatType) -> m (Some (Atom s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> AtomValue ext s 'NatType -> m (Atom s 'NatType)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (Maybe SolverSymbol -> AtomValue ext s 'NatType
forall ext s. Maybe SolverSymbol -> AtomValue ext s 'NatType
FreshNat (SolverSymbol -> Maybe SolverSymbol
forall a. a -> Maybe a
Just SolverSymbol
nm))
           Some TypeRepr x
tp
             | AsBaseType BaseTypeRepr bt
bt <- TypeRepr x -> AsBaseType x
forall (tp :: CrucibleType). TypeRepr tp -> AsBaseType tp
asBaseType TypeRepr x
tp ->
                 Atom s (BaseToType bt) -> Some (Atom s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Atom s (BaseToType bt) -> Some (Atom s))
-> m (Atom s (BaseToType bt)) -> m (Some (Atom s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> AtomValue ext s (BaseToType bt) -> m (Atom s (BaseToType bt))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (BaseTypeRepr bt
-> Maybe SolverSymbol -> AtomValue ext s (BaseToType bt)
forall (bt :: BaseType) ext s.
BaseTypeRepr bt
-> Maybe SolverSymbol -> AtomValue ext s ('BaseToType bt)
FreshConstant BaseTypeRepr bt
bt (SolverSymbol -> Maybe SolverSymbol
forall a. a -> Maybe a
Just SolverSymbol
nm))
             | Bool
otherwise -> Text -> m (Some (Atom s)) -> m (Some (Atom s))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"atomic type" (m (Some (Atom s)) -> m (Some (Atom s)))
-> m (Some (Atom s)) -> m (Some (Atom s))
forall a b. (a -> b) -> a -> b
$ m (Some (Atom s))
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    evaluated :: m (Some (Atom s))
evaluated =
       do Pair TypeRepr tp
_ E ext s tp
e' <- ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth
          Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
          Atom s tp
anAtom <- Position -> E ext s tp -> m (Atom s tp)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s tp
e'
          Some (Atom s) -> m (Some (Atom s))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Some (Atom s) -> m (Some (Atom s)))
-> Some (Atom s) -> m (Some (Atom s))
forall a b. (a -> b) -> a -> b
$ Atom s tp -> Some (Atom s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Atom s tp
anAtom

-- | Parse a list of operands (for example, the arguments to a function)
operands :: forall s ext m tps
          . ( MonadState (SyntaxState s) m
            , MonadWriter [Posd (Stmt ext s)] m
            , MonadIO m
            , MonadSyntax Atomic m
            , IsSyntaxExtension ext
            , ?parserHooks :: ParserHooks ext )
            -- ParserHooks to use for syntax extensions
         => Ctx.Assignment TypeRepr tps
         -- ^ Types of the operands
         -> m (Ctx.Assignment (Atom s) tps)
         -- ^ Atoms for the operands
operands :: forall s ext (m :: * -> *) (tps :: Ctx CrucibleType).
(MonadState (SyntaxState s) m, MonadWriter [Posd (Stmt ext s)] m,
 MonadIO m, MonadSyntax Atomic m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
Assignment TypeRepr tps -> m (Assignment (Atom s) tps)
operands Assignment TypeRepr tps
args = do
  Assignment (Rand ext s) tps
operandExprs <- m (Assignment (Rand ext s) tps) -> m (Assignment (Rand ext s) tps)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
backwards (m (Assignment (Rand ext s) tps)
 -> m (Assignment (Rand ext s) tps))
-> m (Assignment (Rand ext s) tps)
-> m (Assignment (Rand ext s) tps)
forall a b. (a -> b) -> a -> b
$ AssignView TypeRepr tps -> m (Assignment (Rand ext s) tps)
forall (args :: Ctx CrucibleType).
(MonadState (SyntaxState s) m, MonadSyntax Atomic m) =>
AssignView TypeRepr args -> m (Assignment (Rand ext s) args)
go (AssignView TypeRepr tps -> m (Assignment (Rand ext s) tps))
-> AssignView TypeRepr tps -> m (Assignment (Rand ext s) tps)
forall a b. (a -> b) -> a -> b
$ Assignment TypeRepr tps -> AssignView TypeRepr tps
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> AssignView f ctx
Ctx.viewAssign Assignment TypeRepr tps
args
  (forall (x :: CrucibleType). Rand ext s x -> m (Atom s x))
-> forall (x :: Ctx CrucibleType).
   Assignment (Rand ext s) x -> m (Assignment (Atom s) x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: CrucibleType -> *) (g :: CrucibleType -> *)
       (m :: * -> *).
Applicative m =>
(forall (x :: CrucibleType). f x -> m (g x))
-> forall (x :: Ctx CrucibleType).
   Assignment f x -> m (Assignment g x)
traverseFC (\(Rand AST s
a E ext s x
ex) -> Position -> E ext s x -> m (Atom s x)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval (AST s -> Position
forall a. Syntax a -> Position
syntaxPos AST s
a) E ext s x
ex) Assignment (Rand ext s) tps
operandExprs
  where
    go :: (MonadState (SyntaxState s) m, MonadSyntax Atomic m)
       => Ctx.AssignView TypeRepr args
       -> m (Ctx.Assignment (Rand ext s) args)
    go :: forall (args :: Ctx CrucibleType).
(MonadState (SyntaxState s) m, MonadSyntax Atomic m) =>
AssignView TypeRepr args -> m (Assignment (Rand ext s) args)
go AssignView TypeRepr args
Ctx.AssignEmpty = m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m ()
-> m (Assignment (Rand ext s) args)
-> m (Assignment (Rand ext s) args)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Assignment (Rand ext s) args -> m (Assignment (Rand ext s) args)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assignment (Rand ext s) args
Assignment (Rand ext s) EmptyCtx
forall {k} (f :: k -> *). Assignment f EmptyCtx
Ctx.empty
    go (Ctx.AssignExtend Assignment TypeRepr ctx1
ctx' TypeRepr tp
ty) =
      m (E ext s tp)
-> (E ext s tp -> m (Assignment (Rand ext s) args))
-> m (Assignment (Rand ext s) args)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (ReaderT (SyntaxState s) m (E ext s tp) -> m (E ext s tp)
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT (SyntaxState s) m (E ext s tp) -> m (E ext s tp))
-> ReaderT (SyntaxState s) m (E ext s tp) -> m (E ext s tp)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp -> ReaderT (SyntaxState s) m (E ext s tp)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr tp
ty) ((E ext s tp -> m (Assignment (Rand ext s) args))
 -> m (Assignment (Rand ext s) args))
-> (E ext s tp -> m (Assignment (Rand ext s) args))
-> m (Assignment (Rand ext s) args)
forall a b. (a -> b) -> a -> b
$ \E ext s tp
e ->
        do Assignment (Rand ext s) ctx1
rest <- AssignView TypeRepr ctx1 -> m (Assignment (Rand ext s) ctx1)
forall (args :: Ctx CrucibleType).
(MonadState (SyntaxState s) m, MonadSyntax Atomic m) =>
AssignView TypeRepr args -> m (Assignment (Rand ext s) args)
go (Assignment TypeRepr ctx1 -> AssignView TypeRepr ctx1
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> AssignView f ctx
Ctx.viewAssign Assignment TypeRepr ctx1
ctx')
           AST s
this <- m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
           Assignment (Rand ext s) args -> m (Assignment (Rand ext s) args)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Assignment (Rand ext s) args -> m (Assignment (Rand ext s) args))
-> Assignment (Rand ext s) args -> m (Assignment (Rand ext s) args)
forall a b. (a -> b) -> a -> b
$ Assignment (Rand ext s) ctx1
-> Rand ext s tp -> Assignment (Rand ext s) (ctx1 '::> tp)
forall {k} (f :: k -> *) (ctx :: Ctx k) (x :: k).
Assignment f ctx -> f x -> Assignment f (ctx ::> x)
Ctx.extend Assignment (Rand ext s) ctx1
rest (Rand ext s tp -> Assignment (Rand ext s) (ctx1 '::> tp))
-> Rand ext s tp -> Assignment (Rand ext s) (ctx1 '::> tp)
forall a b. (a -> b) -> a -> b
$ AST s -> E ext s tp -> Rand ext s tp
forall ext s (t :: CrucibleType).
AST s -> E ext s t -> Rand ext s t
Rand AST s
this E ext s tp
e

funcall
  :: forall ext s m
   . ( MonadSyntax Atomic m
     , MonadWriter [Posd (Stmt ext s)] m
     , MonadState (SyntaxState s) m
     , MonadIO m
     , IsSyntaxExtension ext
     , ?parserHooks :: ParserHooks ext
     )
  => m (Some (Atom s))
funcall :: forall ext s (m :: * -> *).
(MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
m (Some (Atom s))
funcall =
  m () -> m (Some (Atom s)) -> m (Some (Atom s))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Funcall) (m (Some (Atom s)) -> m (Some (Atom s)))
-> m (Some (Atom s)) -> m (Some (Atom s))
forall a b. (a -> b) -> a -> b
$
  m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (Either Text (Some (Atom s))))
-> m (Some (Atom s))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond (ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth) ((Pair TypeRepr (E ext s) -> m (Either Text (Some (Atom s))))
 -> m (Some (Atom s)))
-> (Pair TypeRepr (E ext s) -> m (Either Text (Some (Atom s))))
-> m (Some (Atom s))
forall a b. (a -> b) -> a -> b
$
    \Pair TypeRepr (E ext s)
x ->
      case Pair TypeRepr (E ext s)
x of
        (Pair (FunctionHandleRepr CtxRepr ctx
funArgs TypeRepr ret
ret) E ext s tp
fun) ->
          do Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
             Atom s tp
funAtom <- Position -> E ext s tp -> m (Atom s tp)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s tp
fun
             Assignment (Atom s) ctx
operandAtoms <- CtxRepr ctx -> m (Assignment (Atom s) ctx)
forall s ext (m :: * -> *) (tps :: Ctx CrucibleType).
(MonadState (SyntaxState s) m, MonadWriter [Posd (Stmt ext s)] m,
 MonadIO m, MonadSyntax Atomic m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
Assignment TypeRepr tps -> m (Assignment (Atom s) tps)
operands CtxRepr ctx
funArgs
             Atom s ret
endAtom <- Position -> AtomValue ext s ret -> m (Atom s ret)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (AtomValue ext s ret -> m (Atom s ret))
-> AtomValue ext s ret -> m (Atom s ret)
forall a b. (a -> b) -> a -> b
$ Atom s ('FunctionHandleType ctx ret)
-> Assignment (Atom s) ctx -> TypeRepr ret -> AtomValue ext s ret
forall s (args :: Ctx CrucibleType) (tp :: CrucibleType) ext.
Atom s (FunctionHandleType args tp)
-> Assignment (Atom s) args -> TypeRepr tp -> AtomValue ext s tp
Call Atom s tp
Atom s ('FunctionHandleType ctx ret)
funAtom Assignment (Atom s) ctx
operandAtoms TypeRepr ret
ret
             Either Text (Some (Atom s)) -> m (Either Text (Some (Atom s)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Some (Atom s)) -> m (Either Text (Some (Atom s))))
-> Either Text (Some (Atom s)) -> m (Either Text (Some (Atom s)))
forall a b. (a -> b) -> a -> b
$ Some (Atom s) -> Either Text (Some (Atom s))
forall a b. b -> Either a b
Right (Some (Atom s) -> Either Text (Some (Atom s)))
-> Some (Atom s) -> Either Text (Some (Atom s))
forall a b. (a -> b) -> a -> b
$ Atom s ret -> Some (Atom s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Atom s ret
endAtom
        Pair TypeRepr (E ext s)
_ -> Either Text (Some (Atom s)) -> m (Either Text (Some (Atom s)))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (Some (Atom s)) -> m (Either Text (Some (Atom s))))
-> Either Text (Some (Atom s)) -> m (Either Text (Some (Atom s)))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (Some (Atom s))
forall a b. a -> Either a b
Left Text
"a function"


located :: MonadSyntax atom m => m a -> m (Posd a)
located :: forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located m a
p = Position -> a -> Posd a
forall v. Position -> v -> Posd v
Posd (Position -> a -> Posd a) -> m Position -> m (a -> Posd a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position m (a -> Posd a) -> m a -> m (Posd a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
p

normStmt' :: forall s m ext
           . ( MonadWriter [Posd (Stmt ext s)] m
             , MonadSyntax Atomic m
             , MonadState (SyntaxState s) m
             , MonadIO m
             , IsSyntaxExtension ext
             , ?parserHooks :: ParserHooks ext) =>
             m ()
normStmt' :: forall s (m :: * -> *) ext.
(MonadWriter [Posd (Stmt ext s)] m, MonadSyntax Atomic m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
m ()
normStmt' =
  m () -> m ()
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (m ()
printStmt m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
printLnStmt m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
letStmt m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m (Some (Atom s)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Some (Atom s))
forall ext s (m :: * -> *).
(MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
m (Some (Atom s))
funcall) m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        m ()
setGlobal m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
setReg m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
setRef m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
dropRef m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        m ()
assertion m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
assumption m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
breakpoint m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (m (Some (Atom s)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserHooks ext
-> forall s (m :: * -> *).
   (MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
    MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
    ?parserHooks::ParserHooks ext) =>
   m (Some (Atom s))
forall ext.
ParserHooks ext
-> forall s (m :: * -> *).
   (MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
    MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
    ?parserHooks::ParserHooks ext) =>
   m (Some (Atom s))
extensionParser ?parserHooks::ParserHooks ext
ParserHooks ext
?parserHooks)))

  where
    printStmt, printLnStmt, letStmt, setGlobal, setReg, setRef, dropRef, assertion, breakpoint :: m ()
    printStmt :: m ()
printStmt =
      do Posd Position
loc E ext s ('BaseToType (BaseStringType 'Unicode))
e <- Keyword
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Print_ (m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (E ext s ('BaseToType (BaseStringType 'Unicode)))
 -> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode)))))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall a b. (a -> b) -> a -> b
$ ReaderT
  (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT
   (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
 -> m (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> ReaderT
     (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> ReaderT
     (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr))
         Atom s ('BaseToType (BaseStringType 'Unicode))
strAtom <- Position
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> m (Atom s ('BaseToType (BaseStringType 'Unicode)))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s ('BaseToType (BaseStringType 'Unicode))
e
         [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
loc (Atom s ('BaseToType (BaseStringType 'Unicode)) -> Stmt ext s
forall ext s.
Atom s ('BaseToType (BaseStringType 'Unicode)) -> Stmt ext s
Print Atom s ('BaseToType (BaseStringType 'Unicode))
strAtom)]

    printLnStmt :: m ()
printLnStmt =
      do Posd Position
loc E ext s ('BaseToType (BaseStringType 'Unicode))
e <- Keyword
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
PrintLn_ (m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (E ext s ('BaseToType (BaseStringType 'Unicode)))
 -> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode)))))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall a b. (a -> b) -> a -> b
$ ReaderT
  (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT
   (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
 -> m (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> ReaderT
     (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> ReaderT
     (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr))
         Atom s ('BaseToType (BaseStringType 'Unicode))
strAtom <- Position
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> m (Atom s ('BaseToType (BaseStringType 'Unicode)))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc (App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (StringInfoRepr 'Unicode
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo) (f :: CrucibleType -> *) ext.
StringInfoRepr si
-> f (StringType si)
-> f (StringType si)
-> App ext f (StringType si)
StringConcat StringInfoRepr 'Unicode
UnicodeRepr E ext s ('BaseToType (BaseStringType 'Unicode))
e (App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
-> E ext s ('BaseToType (BaseStringType 'Unicode))
forall ext s (t :: CrucibleType). App ext (E ext s) t -> E ext s t
EApp (StringLiteral 'Unicode
-> App ext (E ext s) ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo) ext (f :: CrucibleType -> *).
StringLiteral si -> App ext f ('BaseToType (BaseStringType si))
StringLit StringLiteral 'Unicode
"\n"))))
         [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
loc (Atom s ('BaseToType (BaseStringType 'Unicode)) -> Stmt ext s
forall ext s.
Atom s ('BaseToType (BaseStringType 'Unicode)) -> Stmt ext s
Print Atom s ('BaseToType (BaseStringType 'Unicode))
strAtom)]

    letStmt :: m ()
letStmt =
      m () -> m () -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Let) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      m AtomName -> (AtomName -> m ()) -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m AtomName
forall (m :: * -> *) s.
(MonadSyntax Atomic m, MonadState (SyntaxState s) m) =>
m AtomName
uniqueAtom ((AtomName -> m ()) -> m ()) -> (AtomName -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
        \AtomName
x ->
          do Some (Atom s)
setter <- (Some (Atom s), ()) -> Some (Atom s)
forall a b. (a, b) -> a
fst ((Some (Atom s), ()) -> Some (Atom s))
-> m (Some (Atom s), ()) -> m (Some (Atom s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Some (Atom s)) -> m () -> m (Some (Atom s), ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (AtomName -> m (Some (Atom s))
forall (m :: * -> *) ext s.
(MonadSyntax Atomic m, MonadWriter [Posd (Stmt ext s)] m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
AtomName -> m (Some (Atom s))
atomSetter AtomName
x) m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
             (Map AtomName (Some (Atom s))
 -> Identity (Map AtomName (Some (Atom s))))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
-> SyntaxState s -> f (SyntaxState s)
stxAtoms ((Map AtomName (Some (Atom s))
  -> Identity (Map AtomName (Some (Atom s))))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map AtomName (Some (Atom s)) -> Map AtomName (Some (Atom s)))
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= AtomName
-> Some (Atom s)
-> Map AtomName (Some (Atom s))
-> Map AtomName (Some (Atom s))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AtomName
x Some (Atom s)
setter

    setGlobal :: m ()
setGlobal =
      m () -> m () -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
SetGlobal) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      m GlobalName -> (GlobalName -> m (Either Text ())) -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m GlobalName
forall (m :: * -> *). MonadSyntax Atomic m => m GlobalName
globalName ((GlobalName -> m (Either Text ())) -> m ())
-> (GlobalName -> m (Either Text ())) -> m ()
forall a b. (a -> b) -> a -> b
$
        \GlobalName
g ->
          Getting
  (Maybe (Some GlobalVar)) (SyntaxState s) (Maybe (Some GlobalVar))
-> m (Maybe (Some GlobalVar))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Map GlobalName (Some GlobalVar)
 -> Const
      (Maybe (Some GlobalVar)) (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> Const (Maybe (Some GlobalVar)) (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> f (SyntaxState s)
stxGlobals ((Map GlobalName (Some GlobalVar)
  -> Const
       (Maybe (Some GlobalVar)) (Map GlobalName (Some GlobalVar)))
 -> SyntaxState s -> Const (Maybe (Some GlobalVar)) (SyntaxState s))
-> ((Maybe (Some GlobalVar)
     -> Const (Maybe (Some GlobalVar)) (Maybe (Some GlobalVar)))
    -> Map GlobalName (Some GlobalVar)
    -> Const
         (Maybe (Some GlobalVar)) (Map GlobalName (Some GlobalVar)))
-> Getting
     (Maybe (Some GlobalVar)) (SyntaxState s) (Maybe (Some GlobalVar))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map GlobalName (Some GlobalVar))
-> Lens'
     (Map GlobalName (Some GlobalVar))
     (Maybe (IxValue (Map GlobalName (Some GlobalVar))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map GlobalName (Some GlobalVar))
GlobalName
g) m (Maybe (Some GlobalVar))
-> (Maybe (Some GlobalVar) -> m (Either Text ()))
-> m (Either Text ())
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
            \case
              Maybe (Some GlobalVar)
Nothing -> Either Text () -> m (Either Text ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text () -> m (Either Text ()))
-> Either Text () -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"known global variable name"
              Just (Some GlobalVar x
var) ->
                do (Posd Position
loc E ext s x
e) <- (Posd (E ext s x), ()) -> Posd (E ext s x)
forall a b. (a, b) -> a
fst ((Posd (E ext s x), ()) -> Posd (E ext s x))
-> m (Posd (E ext s x), ()) -> m (Posd (E ext s x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Posd (E ext s x)) -> m () -> m (Posd (E ext s x), ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (m (E ext s x) -> m (Posd (E ext s x))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (E ext s x) -> m (Posd (E ext s x)))
-> m (E ext s x) -> m (Posd (E ext s x))
forall a b. (a -> b) -> a -> b
$ ReaderT (SyntaxState s) m (E ext s x) -> m (E ext s x)
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT (SyntaxState s) m (E ext s x) -> m (E ext s x))
-> ReaderT (SyntaxState s) m (E ext s x) -> m (E ext s x)
forall a b. (a -> b) -> a -> b
$ TypeRepr x -> ReaderT (SyntaxState s) m (E ext s x)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (TypeRepr x -> ReaderT (SyntaxState s) m (E ext s x))
-> TypeRepr x -> ReaderT (SyntaxState s) m (E ext s x)
forall a b. (a -> b) -> a -> b
$ GlobalVar x -> TypeRepr x
forall (tp :: CrucibleType). GlobalVar tp -> TypeRepr tp
globalType GlobalVar x
var) m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
                   Atom s x
a <- Position -> E ext s x -> m (Atom s x)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s x
e
                   [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
loc (Stmt ext s -> Posd (Stmt ext s))
-> Stmt ext s -> Posd (Stmt ext s)
forall a b. (a -> b) -> a -> b
$ GlobalVar x -> Atom s x -> Stmt ext s
forall ext s (tp :: CrucibleType).
GlobalVar tp -> Atom s tp -> Stmt ext s
WriteGlobal GlobalVar x
var Atom s x
a]
                   Either Text () -> m (Either Text ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either Text ()
forall a b. b -> Either a b
Right ())

    setReg :: m ()
setReg =
      m () -> m () -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
SetRegister) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      m (Some (Reg s)) -> (Some (Reg s) -> m ()) -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (ReaderT (SyntaxState s) m (Some (Reg s)) -> m (Some (Reg s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading ReaderT (SyntaxState s) m (Some (Reg s))
forall (m :: * -> *) s.
(MonadSyntax Atomic m, MonadReader (SyntaxState s) m) =>
m (Some (Reg s))
regRef') ((Some (Reg s) -> m ()) -> m ()) -> (Some (Reg s) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
      \(Some Reg s x
r) ->
        m (Posd (E ext s x)) -> (Posd (E ext s x) -> m ()) -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (ReaderT (SyntaxState s) m (Posd (E ext s x))
-> m (Posd (E ext s x))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT (SyntaxState s) m (Posd (E ext s x))
 -> m (Posd (E ext s x)))
-> ReaderT (SyntaxState s) m (Posd (E ext s x))
-> m (Posd (E ext s x))
forall a b. (a -> b) -> a -> b
$ ReaderT (SyntaxState s) m (E ext s x)
-> ReaderT (SyntaxState s) m (Posd (E ext s x))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (ReaderT (SyntaxState s) m (E ext s x)
 -> ReaderT (SyntaxState s) m (Posd (E ext s x)))
-> ReaderT (SyntaxState s) m (E ext s x)
-> ReaderT (SyntaxState s) m (Posd (E ext s x))
forall a b. (a -> b) -> a -> b
$ TypeRepr x -> ReaderT (SyntaxState s) m (E ext s x)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (TypeRepr x -> ReaderT (SyntaxState s) m (E ext s x))
-> TypeRepr x -> ReaderT (SyntaxState s) m (E ext s x)
forall a b. (a -> b) -> a -> b
$ Reg s x -> TypeRepr x
forall s (tp :: CrucibleType). Reg s tp -> TypeRepr tp
typeOfReg Reg s x
r) ((Posd (E ext s x) -> m ()) -> m ())
-> (Posd (E ext s x) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
        \(Posd Position
loc E ext s x
e) ->
          do m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
             Atom s x
v <- Position -> E ext s x -> m (Atom s x)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s x
e
             [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
loc (Stmt ext s -> Posd (Stmt ext s))
-> Stmt ext s -> Posd (Stmt ext s)
forall a b. (a -> b) -> a -> b
$ Reg s x -> Atom s x -> Stmt ext s
forall ext s (tp :: CrucibleType).
Reg s tp -> Atom s tp -> Stmt ext s
SetReg Reg s x
r Atom s x
v]

    setRef :: m ()
setRef =
      do Position
stmtLoc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
         m () -> m () -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
SetRef) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
           m (Posd (Pair TypeRepr (E ext s)))
-> (Posd (Pair TypeRepr (E ext s)) -> m (Either Text ())) -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond (m (Pair TypeRepr (E ext s)) -> m (Posd (Pair TypeRepr (E ext s)))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (Pair TypeRepr (E ext s)) -> m (Posd (Pair TypeRepr (E ext s))))
-> m (Pair TypeRepr (E ext s))
-> m (Posd (Pair TypeRepr (E ext s)))
forall a b. (a -> b) -> a -> b
$ ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
 -> m (Pair TypeRepr (E ext s)))
-> ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall a b. (a -> b) -> a -> b
$ ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth) ((Posd (Pair TypeRepr (E ext s)) -> m (Either Text ())) -> m ())
-> (Posd (Pair TypeRepr (E ext s)) -> m (Either Text ())) -> m ()
forall a b. (a -> b) -> a -> b
$
           \case
             (Posd Position
refLoc (Pair (ReferenceRepr TypeRepr a
t') E ext s tp
refE)) ->
               m (Posd (E ext s a))
-> (Posd (E ext s a) -> m (Either Text ())) -> m (Either Text ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (m (E ext s a) -> m (Posd (E ext s a))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (E ext s a) -> m (Posd (E ext s a)))
-> m (E ext s a) -> m (Posd (E ext s a))
forall a b. (a -> b) -> a -> b
$ ReaderT (SyntaxState s) m (E ext s a) -> m (E ext s a)
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT (SyntaxState s) m (E ext s a) -> m (E ext s a))
-> ReaderT (SyntaxState s) m (E ext s a) -> m (E ext s a)
forall a b. (a -> b) -> a -> b
$ TypeRepr a -> ReaderT (SyntaxState s) m (E ext s a)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr a
t') ((Posd (E ext s a) -> m (Either Text ())) -> m (Either Text ()))
-> (Posd (E ext s a) -> m (Either Text ())) -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$
               \(Posd Position
valLoc E ext s a
valE) ->
                 do m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
                    Atom s tp
refAtom <- Position -> E ext s tp -> m (Atom s tp)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
refLoc E ext s tp
refE
                    Atom s a
valAtom <- Position -> E ext s a -> m (Atom s a)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
valLoc E ext s a
valE
                    [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
stmtLoc (Stmt ext s -> Posd (Stmt ext s))
-> Stmt ext s -> Posd (Stmt ext s)
forall a b. (a -> b) -> a -> b
$ Atom s ('ReferenceType a) -> Atom s a -> Stmt ext s
forall ext s (tp :: CrucibleType).
Atom s (ReferenceType tp) -> Atom s tp -> Stmt ext s
WriteRef Atom s tp
Atom s ('ReferenceType a)
refAtom Atom s a
valAtom]
                    Either Text () -> m (Either Text ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Either Text ()
forall a b. b -> Either a b
Right ())
             (Posd Position
_ Pair TypeRepr (E ext s)
_) ->
               Either Text () -> m (Either Text ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text () -> m (Either Text ()))
-> Either Text () -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"expression with reference type"

    dropRef :: m ()
dropRef =
      do Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
         m () -> m () -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
DropRef_) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
           m (Posd (Pair TypeRepr (E ext s)))
-> (Posd (Pair TypeRepr (E ext s)) -> m (Either Text ())) -> m ()
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond (m (Pair TypeRepr (E ext s)) -> m (Posd (Pair TypeRepr (E ext s)))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (Pair TypeRepr (E ext s)) -> m (Posd (Pair TypeRepr (E ext s))))
-> m (Pair TypeRepr (E ext s))
-> m (Posd (Pair TypeRepr (E ext s)))
forall a b. (a -> b) -> a -> b
$ ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth) ((Posd (Pair TypeRepr (E ext s)) -> m (Either Text ())) -> m ())
-> (Posd (Pair TypeRepr (E ext s)) -> m (Either Text ())) -> m ()
forall a b. (a -> b) -> a -> b
$
            \(Posd Position
eLoc (Pair TypeRepr tp
t E ext s tp
refE)) ->
               m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m () -> m (Either Text ()) -> m (Either Text ())
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
               case TypeRepr tp
t of
                 ReferenceRepr TypeRepr a
_ ->
                   do Atom s tp
refAtom <- Position -> E ext s tp -> m (Atom s tp)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
eLoc E ext s tp
refE
                      [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
loc (Stmt ext s -> Posd (Stmt ext s))
-> Stmt ext s -> Posd (Stmt ext s)
forall a b. (a -> b) -> a -> b
$ Atom s ('ReferenceType a) -> Stmt ext s
forall ext s (tp :: CrucibleType).
Atom s (ReferenceType tp) -> Stmt ext s
DropRef Atom s tp
Atom s ('ReferenceType a)
refAtom]
                      Either Text () -> m (Either Text ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text () -> m (Either Text ()))
-> Either Text () -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ () -> Either Text ()
forall a b. b -> Either a b
Right ()
                 TypeRepr tp
_ -> Either Text () -> m (Either Text ())
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text () -> m (Either Text ()))
-> Either Text () -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"expression with reference type"

    assertion :: m ()
assertion =
      do (Posd Position
loc (Posd Position
cLoc E ext s ('BaseToType BaseBoolType)
cond, Posd Position
mLoc E ext s ('BaseToType (BaseStringType 'Unicode))
msg)) <-
           m (Posd (E ext s ('BaseToType BaseBoolType)),
   Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> m (Posd
        (Posd (E ext s ('BaseToType BaseBoolType)),
         Posd (E ext s ('BaseToType (BaseStringType 'Unicode)))))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (Posd (E ext s ('BaseToType BaseBoolType)),
    Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
 -> m (Posd
         (Posd (E ext s ('BaseToType BaseBoolType)),
          Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))))
-> m (Posd (E ext s ('BaseToType BaseBoolType)),
      Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> m (Posd
        (Posd (E ext s ('BaseToType BaseBoolType)),
         Posd (E ext s ('BaseToType (BaseStringType 'Unicode)))))
forall a b. (a -> b) -> a -> b
$
           Keyword
-> m (Posd (E ext s ('BaseToType BaseBoolType)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> m (Posd (E ext s ('BaseToType BaseBoolType)),
      Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
Assert_
             (m (E ext s ('BaseToType BaseBoolType))
-> m (Posd (E ext s ('BaseToType BaseBoolType)))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (E ext s ('BaseToType BaseBoolType))
 -> m (Posd (E ext s ('BaseToType BaseBoolType))))
-> m (E ext s ('BaseToType BaseBoolType))
-> m (Posd (E ext s ('BaseToType BaseBoolType)))
forall a b. (a -> b) -> a -> b
$ ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
-> m (E ext s ('BaseToType BaseBoolType))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
 -> m (E ext s ('BaseToType BaseBoolType)))
-> ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
-> m (E ext s ('BaseToType BaseBoolType))
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ('BaseToType BaseBoolType)
BoolRepr)
             (m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (E ext s ('BaseToType (BaseStringType 'Unicode)))
 -> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode)))))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall a b. (a -> b) -> a -> b
$ ReaderT
  (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT
   (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
 -> m (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> ReaderT
     (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> ReaderT
     (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr))
         Atom s ('BaseToType BaseBoolType)
cond' <- Position
-> E ext s ('BaseToType BaseBoolType)
-> m (Atom s ('BaseToType BaseBoolType))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
cLoc E ext s ('BaseToType BaseBoolType)
cond
         Atom s ('BaseToType (BaseStringType 'Unicode))
msg' <- Position
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> m (Atom s ('BaseToType (BaseStringType 'Unicode)))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
mLoc E ext s ('BaseToType (BaseStringType 'Unicode))
msg
         [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
loc (Stmt ext s -> Posd (Stmt ext s))
-> Stmt ext s -> Posd (Stmt ext s)
forall a b. (a -> b) -> a -> b
$ Atom s ('BaseToType BaseBoolType)
-> Atom s ('BaseToType (BaseStringType 'Unicode)) -> Stmt ext s
forall ext s.
Atom s ('BaseToType BaseBoolType)
-> Atom s ('BaseToType (BaseStringType 'Unicode)) -> Stmt ext s
Assert Atom s ('BaseToType BaseBoolType)
cond' Atom s ('BaseToType (BaseStringType 'Unicode))
msg']

    assumption :: m ()
assumption =
      do (Posd Position
loc (Posd Position
cLoc E ext s ('BaseToType BaseBoolType)
cond, Posd Position
mLoc E ext s ('BaseToType (BaseStringType 'Unicode))
msg)) <-
           m (Posd (E ext s ('BaseToType BaseBoolType)),
   Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> m (Posd
        (Posd (E ext s ('BaseToType BaseBoolType)),
         Posd (E ext s ('BaseToType (BaseStringType 'Unicode)))))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (Posd (E ext s ('BaseToType BaseBoolType)),
    Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
 -> m (Posd
         (Posd (E ext s ('BaseToType BaseBoolType)),
          Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))))
-> m (Posd (E ext s ('BaseToType BaseBoolType)),
      Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> m (Posd
        (Posd (E ext s ('BaseToType BaseBoolType)),
         Posd (E ext s ('BaseToType (BaseStringType 'Unicode)))))
forall a b. (a -> b) -> a -> b
$
           Keyword
-> m (Posd (E ext s ('BaseToType BaseBoolType)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> m (Posd (E ext s ('BaseToType BaseBoolType)),
      Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
Assume_
             (m (E ext s ('BaseToType BaseBoolType))
-> m (Posd (E ext s ('BaseToType BaseBoolType)))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (E ext s ('BaseToType BaseBoolType))
 -> m (Posd (E ext s ('BaseToType BaseBoolType))))
-> m (E ext s ('BaseToType BaseBoolType))
-> m (Posd (E ext s ('BaseToType BaseBoolType)))
forall a b. (a -> b) -> a -> b
$ ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
-> m (E ext s ('BaseToType BaseBoolType))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
 -> m (E ext s ('BaseToType BaseBoolType)))
-> ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
-> m (E ext s ('BaseToType BaseBoolType))
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType BaseBoolType)
-> ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ('BaseToType BaseBoolType)
BoolRepr)
             (m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (E ext s ('BaseToType (BaseStringType 'Unicode)))
 -> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode)))))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall a b. (a -> b) -> a -> b
$ ReaderT
  (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (ReaderT
   (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
 -> m (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> ReaderT
     (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall a b. (a -> b) -> a -> b
$ TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> ReaderT
     (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr))
         Atom s ('BaseToType BaseBoolType)
cond' <- Position
-> E ext s ('BaseToType BaseBoolType)
-> m (Atom s ('BaseToType BaseBoolType))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
cLoc E ext s ('BaseToType BaseBoolType)
cond
         Atom s ('BaseToType (BaseStringType 'Unicode))
msg' <- Position
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> m (Atom s ('BaseToType (BaseStringType 'Unicode)))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
mLoc E ext s ('BaseToType (BaseStringType 'Unicode))
msg
         [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
loc (Stmt ext s -> Posd (Stmt ext s))
-> Stmt ext s -> Posd (Stmt ext s)
forall a b. (a -> b) -> a -> b
$ Atom s ('BaseToType BaseBoolType)
-> Atom s ('BaseToType (BaseStringType 'Unicode)) -> Stmt ext s
forall ext s.
Atom s ('BaseToType BaseBoolType)
-> Atom s ('BaseToType (BaseStringType 'Unicode)) -> Stmt ext s
Assume Atom s ('BaseToType BaseBoolType)
cond' Atom s ('BaseToType (BaseStringType 'Unicode))
msg']

    breakpoint :: m ()
breakpoint =
      do (Posd Position
loc (BreakpointName
nm, [Some (Value s)]
arg_list)) <-
           m (BreakpointName, [Some (Value s)])
-> m (Posd (BreakpointName, [Some (Value s)]))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (BreakpointName, [Some (Value s)])
 -> m (Posd (BreakpointName, [Some (Value s)])))
-> m (BreakpointName, [Some (Value s)])
-> m (Posd (BreakpointName, [Some (Value s)]))
forall a b. (a -> b) -> a -> b
$ Keyword
-> m BreakpointName
-> m [Some (Value s)]
-> m (BreakpointName, [Some (Value s)])
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
Breakpoint_
             (m Text
forall (m :: * -> *). MonadSyntax Atomic m => m Text
string m Text -> (Text -> BreakpointName) -> m BreakpointName
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> BreakpointName
BreakpointName)
             (m (Some (Value s)) -> m [Some (Value s)]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m [a]
rep m (Some (Value s))
ra_value)
         case [Some (Value s)] -> Some (Assignment (Value s))
forall {k} (f :: k -> *). [Some f] -> Some (Assignment f)
toCtx [Some (Value s)]
arg_list of
           Some Assignment (Value s) x
args -> [Posd (Stmt ext s)] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Position -> Stmt ext s -> Posd (Stmt ext s)
forall v. Position -> v -> Posd v
Posd Position
loc (Stmt ext s -> Posd (Stmt ext s))
-> Stmt ext s -> Posd (Stmt ext s)
forall a b. (a -> b) -> a -> b
$ BreakpointName -> Assignment (Value s) x -> Stmt ext s
forall ext s (args :: Ctx CrucibleType).
BreakpointName -> Assignment (Value s) args -> Stmt ext s
Breakpoint BreakpointName
nm Assignment (Value s) x
args]
      where
        ra_value :: m (Some (Value s))
        ra_value :: m (Some (Value s))
ra_value = (ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth) m (Pair TypeRepr (E ext s))
-> (Pair TypeRepr (E ext s) -> m (Some (Value s)))
-> m (Some (Value s))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Pair TypeRepr tp
_ (EReg Position
_ Reg s tp
reg) -> Some (Value s) -> m (Some (Value s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some (Value s) -> m (Some (Value s)))
-> Some (Value s) -> m (Some (Value s))
forall a b. (a -> b) -> a -> b
$ Value s tp -> Some (Value s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Value s tp -> Some (Value s)) -> Value s tp -> Some (Value s)
forall a b. (a -> b) -> a -> b
$ Reg s tp -> Value s tp
forall s (tp :: CrucibleType). Reg s tp -> Value s tp
RegValue Reg s tp
reg
          Pair TypeRepr tp
_ (EAtom Atom s tp
atm) -> Some (Value s) -> m (Some (Value s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some (Value s) -> m (Some (Value s)))
-> Some (Value s) -> m (Some (Value s))
forall a b. (a -> b) -> a -> b
$ Value s tp -> Some (Value s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Value s tp -> Some (Value s)) -> Value s tp -> Some (Value s)
forall a b. (a -> b) -> a -> b
$ Atom s tp -> Value s tp
forall s (tp :: CrucibleType). Atom s tp -> Value s tp
AtomValue Atom s tp
atm
          Pair TypeRepr (E ext s)
_ -> m (Some (Value s))
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty


blockBody' :: forall s ret m ext
            . ( MonadSyntax Atomic m
              , MonadState (SyntaxState s) m
              , MonadIO m
              , IsSyntaxExtension ext
              , ?parserHooks :: ParserHooks ext )
           => TypeRepr ret
           -> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
blockBody' :: forall s (ret :: CrucibleType) (m :: * -> *) ext.
(MonadSyntax Atomic m, MonadState (SyntaxState s) m, MonadIO m,
 IsSyntaxExtension ext, ?parserHooks::ParserHooks ext) =>
TypeRepr ret -> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
blockBody' TypeRepr ret
ret = WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
-> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
go
 where
 go :: WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
 go :: WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
go = ((Posd (TermStmt s ret), ()) -> Posd (TermStmt s ret)
forall a b. (a, b) -> a
fst ((Posd (TermStmt s ret), ()) -> Posd (TermStmt s ret))
-> WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret), ())
-> WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
-> WriterT [Posd (Stmt ext s)] m ()
-> WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret), ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
-> WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (TypeRepr ret
-> WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
forall (m :: * -> *) s (ret :: CrucibleType) ext.
(MonadWriter [Posd (Stmt ext s)] m, MonadSyntax Atomic m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
TypeRepr ret -> m (Posd (TermStmt s ret))
termStmt' TypeRepr ret
ret)) WriterT [Posd (Stmt ext s)] m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList)) WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
-> WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
-> WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
forall a.
WriterT [Posd (Stmt ext s)] m a
-> WriterT [Posd (Stmt ext s)] m a
-> WriterT [Posd (Stmt ext s)] m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      (((), Posd (TermStmt s ret)) -> Posd (TermStmt s ret)
forall a b. (a, b) -> b
snd (((), Posd (TermStmt s ret)) -> Posd (TermStmt s ret))
-> WriterT [Posd (Stmt ext s)] m ((), Posd (TermStmt s ret))
-> WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterT [Posd (Stmt ext s)] m ()
-> WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
-> WriterT [Posd (Stmt ext s)] m ((), Posd (TermStmt s ret))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons (WriterT [Posd (Stmt ext s)] m ()
-> WriterT [Posd (Stmt ext s)] m ()
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later WriterT [Posd (Stmt ext s)] m ()
forall s (m :: * -> *) ext.
(MonadWriter [Posd (Stmt ext s)] m, MonadSyntax Atomic m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
m ()
normStmt') WriterT [Posd (Stmt ext s)] m (Posd (TermStmt s ret))
go))

termStmt' :: forall m s ret ext.
   ( MonadWriter [Posd (Stmt ext s)] m
   , MonadSyntax Atomic m
   , MonadState (SyntaxState s) m
   , MonadIO m
   , IsSyntaxExtension ext
   , ?parserHooks :: ParserHooks ext ) =>
   TypeRepr ret -> m (Posd (TermStmt s ret))
termStmt' :: forall (m :: * -> *) s (ret :: CrucibleType) ext.
(MonadWriter [Posd (Stmt ext s)] m, MonadSyntax Atomic m,
 MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
TypeRepr ret -> m (Posd (TermStmt s ret))
termStmt' TypeRepr ret
retTy =
  do AST s
stx <- m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
     m (Posd (TermStmt s ret)) -> m (Posd (TermStmt s ret))
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (AST s -> TermStmt s ret -> Posd (TermStmt s ret)
forall a b. Syntax a -> b -> Posd b
withPosFrom AST s
stx (TermStmt s ret -> Posd (TermStmt s ret))
-> m (TermStmt s ret) -> m (Posd (TermStmt s ret))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       (m (TermStmt s ret)
jump m (TermStmt s ret) -> m (TermStmt s ret) -> m (TermStmt s ret)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (TermStmt s ret)
branch m (TermStmt s ret) -> m (TermStmt s ret) -> m (TermStmt s ret)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (TermStmt s ret)
maybeBranch m (TermStmt s ret) -> m (TermStmt s ret) -> m (TermStmt s ret)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (TermStmt s ret)
cases m (TermStmt s ret) -> m (TermStmt s ret) -> m (TermStmt s ret)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (TermStmt s ret)
ret m (TermStmt s ret) -> m (TermStmt s ret) -> m (TermStmt s ret)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (TermStmt s ret)
err m (TermStmt s ret) -> m (TermStmt s ret) -> m (TermStmt s ret)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (TermStmt s ret)
tailCall m (TermStmt s ret) -> m (TermStmt s ret) -> m (TermStmt s ret)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (TermStmt s ret)
out))

  where
    normalLabel :: m (Label s)
normalLabel =
      do LabelName
x <- m LabelName
forall (m :: * -> *). MonadSyntax Atomic m => m LabelName
labelName
         Maybe (LabelInfo s)
l <- Getting (Maybe (LabelInfo s)) (SyntaxState s) (Maybe (LabelInfo s))
-> m (Maybe (LabelInfo s))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Map LabelName (LabelInfo s)
 -> Const (Maybe (LabelInfo s)) (Map LabelName (LabelInfo s)))
-> SyntaxState s -> Const (Maybe (LabelInfo s)) (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map LabelName (LabelInfo s) -> f (Map LabelName (LabelInfo s)))
-> SyntaxState s -> f (SyntaxState s)
stxLabels ((Map LabelName (LabelInfo s)
  -> Const (Maybe (LabelInfo s)) (Map LabelName (LabelInfo s)))
 -> SyntaxState s -> Const (Maybe (LabelInfo s)) (SyntaxState s))
-> ((Maybe (LabelInfo s)
     -> Const (Maybe (LabelInfo s)) (Maybe (LabelInfo s)))
    -> Map LabelName (LabelInfo s)
    -> Const (Maybe (LabelInfo s)) (Map LabelName (LabelInfo s)))
-> Getting
     (Maybe (LabelInfo s)) (SyntaxState s) (Maybe (LabelInfo s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map LabelName (LabelInfo s))
-> Lens'
     (Map LabelName (LabelInfo s))
     (Maybe (IxValue (Map LabelName (LabelInfo s))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map LabelName (LabelInfo s))
LabelName
x)
         m (Label s) -> m (Label s)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (Label s) -> m (Label s)) -> m (Label s) -> m (Label s)
forall a b. (a -> b) -> a -> b
$ Text -> m (Label s) -> m (Label s)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"known label with no arguments" (m (Label s) -> m (Label s)) -> m (Label s) -> m (Label s)
forall a b. (a -> b) -> a -> b
$
           case Maybe (LabelInfo s)
l of
             Maybe (LabelInfo s)
Nothing -> m (Label s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
             Just (ArgLbl LambdaLabel s ty
_) -> m (Label s)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
             Just (NoArgLbl Label s
lbl) -> Label s -> m (Label s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Label s
lbl

    lambdaLabel :: m (Some (LambdaLabel s))
    lambdaLabel :: m (Some (LambdaLabel s))
lambdaLabel =
      do LabelName
x <- m LabelName
forall (m :: * -> *). MonadSyntax Atomic m => m LabelName
labelName
         Maybe (LabelInfo s)
l <- Getting (Maybe (LabelInfo s)) (SyntaxState s) (Maybe (LabelInfo s))
-> m (Maybe (LabelInfo s))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Map LabelName (LabelInfo s)
 -> Const (Maybe (LabelInfo s)) (Map LabelName (LabelInfo s)))
-> SyntaxState s -> Const (Maybe (LabelInfo s)) (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map LabelName (LabelInfo s) -> f (Map LabelName (LabelInfo s)))
-> SyntaxState s -> f (SyntaxState s)
stxLabels ((Map LabelName (LabelInfo s)
  -> Const (Maybe (LabelInfo s)) (Map LabelName (LabelInfo s)))
 -> SyntaxState s -> Const (Maybe (LabelInfo s)) (SyntaxState s))
-> ((Maybe (LabelInfo s)
     -> Const (Maybe (LabelInfo s)) (Maybe (LabelInfo s)))
    -> Map LabelName (LabelInfo s)
    -> Const (Maybe (LabelInfo s)) (Map LabelName (LabelInfo s)))
-> Getting
     (Maybe (LabelInfo s)) (SyntaxState s) (Maybe (LabelInfo s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map LabelName (LabelInfo s))
-> Lens'
     (Map LabelName (LabelInfo s))
     (Maybe (IxValue (Map LabelName (LabelInfo s))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map LabelName (LabelInfo s))
LabelName
x)
         m (Some (LambdaLabel s)) -> m (Some (LambdaLabel s))
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (Some (LambdaLabel s)) -> m (Some (LambdaLabel s)))
-> m (Some (LambdaLabel s)) -> m (Some (LambdaLabel s))
forall a b. (a -> b) -> a -> b
$ Text -> m (Some (LambdaLabel s)) -> m (Some (LambdaLabel s))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"known label with an argument" (m (Some (LambdaLabel s)) -> m (Some (LambdaLabel s)))
-> m (Some (LambdaLabel s)) -> m (Some (LambdaLabel s))
forall a b. (a -> b) -> a -> b
$
           case Maybe (LabelInfo s)
l of
             Maybe (LabelInfo s)
Nothing -> m (Some (LambdaLabel s))
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
             Just (ArgLbl LambdaLabel s ty
lbl) -> Some (LambdaLabel s) -> m (Some (LambdaLabel s))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Some (LambdaLabel s) -> m (Some (LambdaLabel s)))
-> Some (LambdaLabel s) -> m (Some (LambdaLabel s))
forall a b. (a -> b) -> a -> b
$ LambdaLabel s ty -> Some (LambdaLabel s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some LambdaLabel s ty
lbl
             Just (NoArgLbl Label s
_) -> m (Some (LambdaLabel s))
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    typedLambdaLabel :: TypeRepr t -> m (LambdaLabel s t)
    typedLambdaLabel :: forall (t :: CrucibleType). TypeRepr t -> m (LambdaLabel s t)
typedLambdaLabel TypeRepr t
t =
      do LabelName
x <- m LabelName
forall (m :: * -> *). MonadSyntax Atomic m => m LabelName
labelName
         Maybe (LabelInfo s)
l <- Getting (Maybe (LabelInfo s)) (SyntaxState s) (Maybe (LabelInfo s))
-> m (Maybe (LabelInfo s))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((Map LabelName (LabelInfo s)
 -> Const (Maybe (LabelInfo s)) (Map LabelName (LabelInfo s)))
-> SyntaxState s -> Const (Maybe (LabelInfo s)) (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map LabelName (LabelInfo s) -> f (Map LabelName (LabelInfo s)))
-> SyntaxState s -> f (SyntaxState s)
stxLabels ((Map LabelName (LabelInfo s)
  -> Const (Maybe (LabelInfo s)) (Map LabelName (LabelInfo s)))
 -> SyntaxState s -> Const (Maybe (LabelInfo s)) (SyntaxState s))
-> ((Maybe (LabelInfo s)
     -> Const (Maybe (LabelInfo s)) (Maybe (LabelInfo s)))
    -> Map LabelName (LabelInfo s)
    -> Const (Maybe (LabelInfo s)) (Map LabelName (LabelInfo s)))
-> Getting
     (Maybe (LabelInfo s)) (SyntaxState s) (Maybe (LabelInfo s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map LabelName (LabelInfo s))
-> Lens'
     (Map LabelName (LabelInfo s))
     (Maybe (IxValue (Map LabelName (LabelInfo s))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map LabelName (LabelInfo s))
LabelName
x)
         m (LambdaLabel s t) -> m (LambdaLabel s t)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
later (m (LambdaLabel s t) -> m (LambdaLabel s t))
-> m (LambdaLabel s t) -> m (LambdaLabel s t)
forall a b. (a -> b) -> a -> b
$ Text -> m (LambdaLabel s t) -> m (LambdaLabel s t)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"known label with an " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr t -> String
forall a. Show a => a -> String
show TypeRepr t
t) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" argument") (m (LambdaLabel s t) -> m (LambdaLabel s t))
-> m (LambdaLabel s t) -> m (LambdaLabel s t)
forall a b. (a -> b) -> a -> b
$
           case Maybe (LabelInfo s)
l of
             Maybe (LabelInfo s)
Nothing -> m (LambdaLabel s t)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
             Just (ArgLbl LambdaLabel s ty
lbl) ->
               case TypeRepr ty -> TypeRepr t -> Maybe (ty :~: t)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality (Atom s ty -> TypeRepr ty
forall s (tp :: CrucibleType). Atom s tp -> TypeRepr tp
typeOfAtom (LambdaLabel s ty -> Atom s ty
forall s (tp :: CrucibleType). LambdaLabel s tp -> Atom s tp
lambdaAtom LambdaLabel s ty
lbl)) TypeRepr t
t of
                 Maybe (ty :~: t)
Nothing -> m (LambdaLabel s t)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
                 Just ty :~: t
Refl -> LambdaLabel s t -> m (LambdaLabel s t)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LambdaLabel s t
LambdaLabel s ty
lbl
             Just (NoArgLbl Label s
_) -> m (LambdaLabel s t)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    jump :: m (TermStmt s ret)
jump = Keyword -> m (Label s) -> m (Label s)
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Jump_ m (Label s)
normalLabel m (Label s) -> (Label s -> TermStmt s ret) -> m (TermStmt s ret)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Label s -> TermStmt s ret
forall s (ret :: CrucibleType). Label s -> TermStmt s ret
Jump

    branch :: m (TermStmt s ret)
branch = Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Branch_ m () -> m (TermStmt s ret) -> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy`
             (m (Posd (E ext s ('BaseToType BaseBoolType)))
-> (Posd (E ext s ('BaseToType BaseBoolType))
    -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (m (E ext s ('BaseToType BaseBoolType))
-> m (Posd (E ext s ('BaseToType BaseBoolType)))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
-> m (E ext s ('BaseToType BaseBoolType))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (TypeRepr ('BaseToType BaseBoolType)
-> ReaderT (SyntaxState s) m (E ext s ('BaseToType BaseBoolType))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ('BaseToType BaseBoolType)
BoolRepr))) ((Posd (E ext s ('BaseToType BaseBoolType)) -> m (TermStmt s ret))
 -> m (TermStmt s ret))
-> (Posd (E ext s ('BaseToType BaseBoolType))
    -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
                \ (Posd Position
eloc E ext s ('BaseToType BaseBoolType)
cond) ->
                  m (Label s) -> m (Label s, ()) -> m (Label s, (Label s, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m (Label s)
normalLabel (m (Label s) -> m () -> m (Label s, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m (Label s)
normalLabel m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList) m (Label s, (Label s, ()))
-> ((Label s, (Label s, ())) -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                  \(Label s
l1, (Label s
l2, ())) -> do
                    Atom s ('BaseToType BaseBoolType)
c <- Position
-> E ext s ('BaseToType BaseBoolType)
-> m (Atom s ('BaseToType BaseBoolType))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
eloc E ext s ('BaseToType BaseBoolType)
cond
                    TermStmt s ret -> m (TermStmt s ret)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Atom s ('BaseToType BaseBoolType)
-> Label s -> Label s -> TermStmt s ret
forall s (ret :: CrucibleType).
Atom s ('BaseToType BaseBoolType)
-> Label s -> Label s -> TermStmt s ret
Br Atom s ('BaseToType BaseBoolType)
c Label s
l1 Label s
l2))

    maybeBranch :: m (TermStmt s ret)
    maybeBranch :: m (TermStmt s ret)
maybeBranch =
      m () -> m (TermStmt s ret) -> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
MaybeBranch_) (m (TermStmt s ret) -> m (TermStmt s ret))
-> m (TermStmt s ret) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
      Text -> m (TermStmt s ret) -> m (TermStmt s ret)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"valid arguments to maybe-branch" (m (TermStmt s ret) -> m (TermStmt s ret))
-> m (TermStmt s ret) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
      m (Posd (Pair TypeRepr (E ext s)))
-> (Posd (Pair TypeRepr (E ext s)) -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (m (Pair TypeRepr (E ext s)) -> m (Posd (Pair TypeRepr (E ext s)))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth)) ((Posd (Pair TypeRepr (E ext s)) -> m (TermStmt s ret))
 -> m (TermStmt s ret))
-> (Posd (Pair TypeRepr (E ext s)) -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
        \(Posd Position
sloc (Pair TypeRepr tp
ty E ext s tp
scrut)) ->
          case TypeRepr tp
ty of
            MaybeRepr TypeRepr tp1
ty' ->
              m (LambdaLabel s tp1)
-> (LambdaLabel s tp1 -> m (TermStmt s ret)) -> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (TypeRepr tp1 -> m (LambdaLabel s tp1)
forall (t :: CrucibleType). TypeRepr t -> m (LambdaLabel s t)
typedLambdaLabel TypeRepr tp1
ty') ((LambdaLabel s tp1 -> m (TermStmt s ret)) -> m (TermStmt s ret))
-> (LambdaLabel s tp1 -> m (TermStmt s ret)) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
                \LambdaLabel s tp1
lbl1 ->
                  m (Label s)
-> (Label s -> m (TermStmt s ret)) -> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Label s)
normalLabel ((Label s -> m (TermStmt s ret)) -> m (TermStmt s ret))
-> (Label s -> m (TermStmt s ret)) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
                    \ Label s
lbl2 ->
                      do Atom s tp
s <- Position -> E ext s tp -> m (Atom s tp)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
sloc E ext s tp
scrut
                         TermStmt s ret -> m (TermStmt s ret)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TermStmt s ret -> m (TermStmt s ret))
-> TermStmt s ret -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$ TypeRepr tp1
-> Atom s ('MaybeType tp1)
-> LambdaLabel s tp1
-> Label s
-> TermStmt s ret
forall (tp :: CrucibleType) s (ret :: CrucibleType).
TypeRepr tp
-> Atom s (MaybeType tp)
-> LambdaLabel s tp
-> Label s
-> TermStmt s ret
MaybeBranch TypeRepr tp1
ty' Atom s tp
Atom s ('MaybeType tp1)
s LambdaLabel s tp1
lbl1 Label s
lbl2
            TypeRepr tp
_ -> m (TermStmt s ret)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    cases :: m (TermStmt s ret)
    cases :: m (TermStmt s ret)
cases =
      m () -> m (TermStmt s ret) -> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Case) (m (TermStmt s ret) -> m (TermStmt s ret))
-> m (TermStmt s ret) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
      m (Posd (Pair TypeRepr (E ext s)))
-> (Posd (Pair TypeRepr (E ext s)) -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (m (Pair TypeRepr (E ext s)) -> m (Posd (Pair TypeRepr (E ext s)))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth)) ((Posd (Pair TypeRepr (E ext s)) -> m (TermStmt s ret))
 -> m (TermStmt s ret))
-> (Posd (Pair TypeRepr (E ext s)) -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
        \(Posd Position
tgtloc (Pair TypeRepr tp
ty E ext s tp
tgt)) ->
          Text -> m (TermStmt s ret) -> m (TermStmt s ret)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"cases for variant type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TypeRepr tp -> String
forall a. Show a => a -> String
show TypeRepr tp
ty)) (m (TermStmt s ret) -> m (TermStmt s ret))
-> m (TermStmt s ret) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
          case TypeRepr tp
ty of
            VariantRepr CtxRepr ctx
ctx ->
              do Atom s tp
t <- Position -> E ext s tp -> m (Atom s tp)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
tgtloc E ext s tp
tgt
                 CtxRepr ctx
-> Atom s ('VariantType ctx)
-> Assignment (LambdaLabel s) ctx
-> TermStmt s ret
forall (varctx :: Ctx CrucibleType) s (ret :: CrucibleType).
CtxRepr varctx
-> Atom s (VariantType varctx)
-> Assignment (LambdaLabel s) varctx
-> TermStmt s ret
VariantElim CtxRepr ctx
ctx Atom s tp
Atom s ('VariantType ctx)
t (Assignment (LambdaLabel s) ctx -> TermStmt s ret)
-> m (Assignment (LambdaLabel s) ctx) -> m (TermStmt s ret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Assignment (LambdaLabel s) ctx)
-> m (Assignment (LambdaLabel s) ctx)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
backwards (AssignView TypeRepr ctx -> m (Assignment (LambdaLabel s) ctx)
forall (cases :: Ctx CrucibleType).
AssignView TypeRepr cases -> m (Assignment (LambdaLabel s) cases)
go (CtxRepr ctx -> AssignView TypeRepr ctx
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> AssignView f ctx
Ctx.viewAssign CtxRepr ctx
ctx))
            TypeRepr tp
_ -> m (TermStmt s ret)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
      where
        go :: forall cases
            . Ctx.AssignView TypeRepr cases
           -> m (Ctx.Assignment (LambdaLabel s) cases)
        go :: forall (cases :: Ctx CrucibleType).
AssignView TypeRepr cases -> m (Assignment (LambdaLabel s) cases)
go AssignView TypeRepr cases
Ctx.AssignEmpty = m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m ()
-> Assignment (LambdaLabel s) cases
-> m (Assignment (LambdaLabel s) cases)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Assignment (LambdaLabel s) cases
Assignment (LambdaLabel s) EmptyCtx
forall {k} (f :: k -> *). Assignment f EmptyCtx
Ctx.empty
        go (Ctx.AssignExtend Assignment TypeRepr ctx1
ctx' TypeRepr tp
t) =
          m (LambdaLabel s tp)
-> (LambdaLabel s tp -> m (Assignment (LambdaLabel s) cases))
-> m (Assignment (LambdaLabel s) cases)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (TypeRepr tp -> m (LambdaLabel s tp)
forall (t :: CrucibleType). TypeRepr t -> m (LambdaLabel s t)
typedLambdaLabel TypeRepr tp
t) ((LambdaLabel s tp -> m (Assignment (LambdaLabel s) cases))
 -> m (Assignment (LambdaLabel s) cases))
-> (LambdaLabel s tp -> m (Assignment (LambdaLabel s) cases))
-> m (Assignment (LambdaLabel s) cases)
forall a b. (a -> b) -> a -> b
$
            \ LambdaLabel s tp
lbl -> Assignment (LambdaLabel s) ctx1
-> LambdaLabel s tp -> Assignment (LambdaLabel s) cases
Assignment (LambdaLabel s) ctx1
-> LambdaLabel s tp -> Assignment (LambdaLabel s) (ctx1 '::> tp)
forall {k} (f :: k -> *) (ctx :: Ctx k) (x :: k).
Assignment f ctx -> f x -> Assignment f (ctx ::> x)
Ctx.extend (Assignment (LambdaLabel s) ctx1
 -> LambdaLabel s tp -> Assignment (LambdaLabel s) cases)
-> m (Assignment (LambdaLabel s) ctx1)
-> m (LambdaLabel s tp -> Assignment (LambdaLabel s) cases)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       AssignView TypeRepr ctx1 -> m (Assignment (LambdaLabel s) ctx1)
forall (cases :: Ctx CrucibleType).
AssignView TypeRepr cases -> m (Assignment (LambdaLabel s) cases)
go (Assignment TypeRepr ctx1 -> AssignView TypeRepr ctx1
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> AssignView f ctx
Ctx.viewAssign Assignment TypeRepr ctx1
ctx') m (LambdaLabel s tp -> Assignment (LambdaLabel s) cases)
-> m (LambdaLabel s tp) -> m (Assignment (LambdaLabel s) cases)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                       LambdaLabel s tp -> m (LambdaLabel s tp)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LambdaLabel s tp
lbl

    ret :: m (TermStmt s ret)
    ret :: m (TermStmt s ret)
ret =
        do Posd Position
loc E ext s ret
e <- Keyword -> m (Posd (E ext s ret)) -> m (Posd (E ext s ret))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Return_ (m (E ext s ret) -> m (Posd (E ext s ret))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (ReaderT (SyntaxState s) m (E ext s ret) -> m (E ext s ret)
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (TypeRepr ret -> ReaderT (SyntaxState s) m (E ext s ret)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr ret
retTy)))
           Atom s ret -> TermStmt s ret
forall s (ret :: CrucibleType). Atom s ret -> TermStmt s ret
Return (Atom s ret -> TermStmt s ret)
-> m (Atom s ret) -> m (TermStmt s ret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> E ext s ret -> m (Atom s ret)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s ret
e

    tailCall :: m (TermStmt s ret)
    tailCall :: m (TermStmt s ret)
tailCall =
      m () -> m (TermStmt s ret) -> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
TailCall_) (m (TermStmt s ret) -> m (TermStmt s ret))
-> m (TermStmt s ret) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
        Text -> m (TermStmt s ret) -> m (TermStmt s ret)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"function atom and arguments" (m (TermStmt s ret) -> m (TermStmt s ret))
-> m (TermStmt s ret) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
          do -- commit
             m (Posd (Pair TypeRepr (E ext s)))
-> (Posd (Pair TypeRepr (E ext s)) -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (m (Pair TypeRepr (E ext s)) -> m (Posd (Pair TypeRepr (E ext s)))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
-> m (Pair TypeRepr (E ext s))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading ReaderT (SyntaxState s) m (Pair TypeRepr (E ext s))
forall (m :: * -> *) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
m (Pair TypeRepr (E ext s))
synth)) ((Posd (Pair TypeRepr (E ext s)) -> m (TermStmt s ret))
 -> m (TermStmt s ret))
-> (Posd (Pair TypeRepr (E ext s)) -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
               \case
                 Posd Position
loc (Pair (FunctionHandleRepr CtxRepr ctx
argumentTypes TypeRepr ret
retTy') E ext s tp
funExpr) ->
                   case TypeRepr ret -> TypeRepr ret -> Maybe (ret :~: ret)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: CrucibleType) (b :: CrucibleType).
TypeRepr a -> TypeRepr b -> Maybe (a :~: b)
testEquality TypeRepr ret
retTy TypeRepr ret
retTy' of
                       Maybe (ret :~: ret)
Nothing -> m (TermStmt s ret)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
                       Just ret :~: ret
Refl ->
                         do Atom s tp
funAtom <- Position -> E ext s tp -> m (Atom s tp)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s tp
funExpr
                            Text -> m (TermStmt s ret) -> m (TermStmt s ret)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe (Text
"arguments with types " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CtxRepr ctx -> String
forall a. Show a => a -> String
show CtxRepr ctx
argumentTypes)) (m (TermStmt s ret) -> m (TermStmt s ret))
-> m (TermStmt s ret) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
                              Atom s (FunctionHandleType ctx ret)
-> CtxRepr ctx -> Assignment (Atom s) ctx -> TermStmt s ret
forall s (args :: Ctx CrucibleType) (ret :: CrucibleType).
Atom s (FunctionHandleType args ret)
-> CtxRepr args -> Assignment (Atom s) args -> TermStmt s ret
TailCall Atom s tp
Atom s (FunctionHandleType ctx ret)
funAtom CtxRepr ctx
argumentTypes (Assignment (Atom s) ctx -> TermStmt s ret)
-> m (Assignment (Atom s) ctx) -> m (TermStmt s ret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Assignment (Atom s) ctx) -> m (Assignment (Atom s) ctx)
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
backwards (AssignView TypeRepr ctx -> m (Assignment (Atom s) ctx)
forall (argTypes :: Ctx CrucibleType).
AssignView TypeRepr argTypes -> m (Assignment (Atom s) argTypes)
go (CtxRepr ctx -> AssignView TypeRepr ctx
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> AssignView f ctx
Ctx.viewAssign CtxRepr ctx
argumentTypes))
                 Posd (Pair TypeRepr (E ext s))
_ -> m (TermStmt s ret)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
      where
        go :: forall argTypes
            . Ctx.AssignView TypeRepr argTypes
           -> m (Ctx.Assignment (Atom s) argTypes)
        go :: forall (argTypes :: Ctx CrucibleType).
AssignView TypeRepr argTypes -> m (Assignment (Atom s) argTypes)
go AssignView TypeRepr argTypes
Ctx.AssignEmpty = m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m ()
-> m (Assignment (Atom s) argTypes)
-> m (Assignment (Atom s) argTypes)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Assignment (Atom s) argTypes -> m (Assignment (Atom s) argTypes)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assignment (Atom s) argTypes
Assignment (Atom s) EmptyCtx
forall {k} (f :: k -> *). Assignment f EmptyCtx
Ctx.empty
        go (Ctx.AssignExtend Assignment TypeRepr ctx1
tys TypeRepr tp
ty) =
          m (Posd (E ext s tp))
-> (Posd (E ext s tp) -> m (Assignment (Atom s) argTypes))
-> m (Assignment (Atom s) argTypes)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (m (E ext s tp) -> m (Posd (E ext s tp))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (ReaderT (SyntaxState s) m (E ext s tp) -> m (E ext s tp)
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (TypeRepr tp -> ReaderT (SyntaxState s) m (E ext s tp)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check TypeRepr tp
ty))) ((Posd (E ext s tp) -> m (Assignment (Atom s) argTypes))
 -> m (Assignment (Atom s) argTypes))
-> (Posd (E ext s tp) -> m (Assignment (Atom s) argTypes))
-> m (Assignment (Atom s) argTypes)
forall a b. (a -> b) -> a -> b
$
            \(Posd Position
loc E ext s tp
arg) ->
               Assignment (Atom s) ctx1
-> Atom s tp -> Assignment (Atom s) argTypes
Assignment (Atom s) ctx1
-> Atom s tp -> Assignment (Atom s) (ctx1 '::> tp)
forall {k} (f :: k -> *) (ctx :: Ctx k) (x :: k).
Assignment f ctx -> f x -> Assignment f (ctx ::> x)
Ctx.extend (Assignment (Atom s) ctx1
 -> Atom s tp -> Assignment (Atom s) argTypes)
-> m (Assignment (Atom s) ctx1)
-> m (Atom s tp -> Assignment (Atom s) argTypes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AssignView TypeRepr ctx1 -> m (Assignment (Atom s) ctx1)
forall (argTypes :: Ctx CrucibleType).
AssignView TypeRepr argTypes -> m (Assignment (Atom s) argTypes)
go (Assignment TypeRepr ctx1 -> AssignView TypeRepr ctx1
forall {k} (f :: k -> *) (ctx :: Ctx k).
Assignment f ctx -> AssignView f ctx
Ctx.viewAssign Assignment TypeRepr ctx1
tys) m (Atom s tp -> Assignment (Atom s) argTypes)
-> m (Atom s tp) -> m (Assignment (Atom s) argTypes)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Position -> E ext s tp -> m (Atom s tp)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s tp
arg

    err :: m (TermStmt s ret)
    err :: m (TermStmt s ret)
err =
      do Posd Position
loc E ext s ('BaseToType (BaseStringType 'Unicode))
e <- Keyword
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall (m :: * -> *) a.
MonadSyntax Atomic m =>
Keyword -> m a -> m a
unary Keyword
Error_ (m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (Posd (E ext s ('BaseToType (BaseStringType 'Unicode))))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (ReaderT
  (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
-> m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (TypeRepr ('BaseToType (BaseStringType 'Unicode))
-> ReaderT
     (SyntaxState s) m (E ext s ('BaseToType (BaseStringType 'Unicode)))
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (StringInfoRepr 'Unicode
-> TypeRepr ('BaseToType (BaseStringType 'Unicode))
forall (si :: StringInfo).
StringInfoRepr si -> TypeRepr ('BaseToType (BaseStringType si))
StringRepr StringInfoRepr 'Unicode
UnicodeRepr))))
         Atom s ('BaseToType (BaseStringType 'Unicode)) -> TermStmt s ret
forall s (ret :: CrucibleType).
Atom s ('BaseToType (BaseStringType 'Unicode)) -> TermStmt s ret
ErrorStmt (Atom s ('BaseToType (BaseStringType 'Unicode)) -> TermStmt s ret)
-> m (Atom s ('BaseToType (BaseStringType 'Unicode)))
-> m (TermStmt s ret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> E ext s ('BaseToType (BaseStringType 'Unicode))
-> m (Atom s ('BaseToType (BaseStringType 'Unicode)))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s ('BaseToType (BaseStringType 'Unicode))
e

    out :: m (TermStmt s ret)
    out :: m (TermStmt s ret)
out = m () -> m (TermStmt s ret) -> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Output_) (m (TermStmt s ret) -> m (TermStmt s ret))
-> m (TermStmt s ret) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
          do -- commit
             m (Some (LambdaLabel s))
-> (Some (LambdaLabel s) -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Some (LambdaLabel s))
lambdaLabel ((Some (LambdaLabel s) -> m (TermStmt s ret))
 -> m (TermStmt s ret))
-> (Some (LambdaLabel s) -> m (TermStmt s ret))
-> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
               \(Some LambdaLabel s x
lbl) ->
                 m (Posd (E ext s x))
-> (Posd (E ext s x) -> m (TermStmt s ret)) -> m (TermStmt s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons (m (E ext s x) -> m (Posd (E ext s x))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (ReaderT (SyntaxState s) m (E ext s x) -> m (E ext s x)
forall r (m :: * -> *) b. MonadState r m => ReaderT r m b -> m b
reading (TypeRepr x -> ReaderT (SyntaxState s) m (E ext s x)
forall (m :: * -> *) (t :: CrucibleType) s ext.
(MonadReader (SyntaxState s) m, MonadSyntax Atomic m,
 ?parserHooks::ParserHooks ext) =>
TypeRepr t -> m (E ext s t)
check (Atom s x -> TypeRepr x
forall s (tp :: CrucibleType). Atom s tp -> TypeRepr tp
typeOfAtom (LambdaLabel s x -> Atom s x
forall s (tp :: CrucibleType). LambdaLabel s tp -> Atom s tp
lambdaAtom LambdaLabel s x
lbl))))) ((Posd (E ext s x) -> m (TermStmt s ret)) -> m (TermStmt s ret))
-> (Posd (E ext s x) -> m (TermStmt s ret)) -> m (TermStmt s ret)
forall a b. (a -> b) -> a -> b
$
                   \(Posd Position
loc E ext s x
arg) ->
                     m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m () -> m (TermStmt s ret) -> m (TermStmt s ret)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                       (LambdaLabel s x -> Atom s x -> TermStmt s ret
forall s (tp :: CrucibleType) (ret :: CrucibleType).
LambdaLabel s tp -> Atom s tp -> TermStmt s ret
Output LambdaLabel s x
lbl (Atom s x -> TermStmt s ret) -> m (Atom s x) -> m (TermStmt s ret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position -> E ext s x -> m (Atom s x)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc E ext s x
arg)



data Rand ext s t = Rand (AST s) (E ext s t)




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

data Arg t = Arg AtomName Position (TypeRepr t)

someAssign ::
  forall m ext a.
  ( MonadSyntax Atomic m
  , ?parserHooks :: ParserHooks ext
  ) =>
  Text ->
  m (Some a) ->
  m (Some (Ctx.Assignment a))
someAssign :: forall {k} (m :: * -> *) ext (a :: k -> *).
(MonadSyntax Atomic m, ?parserHooks::ParserHooks ext) =>
Text -> m (Some a) -> m (Some (Assignment a))
someAssign Text
desc m (Some a)
sub = m (Some (Assignment a)) -> m (Some (Assignment a))
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (Some (Assignment a) -> m (Some (Assignment a))
go (Assignment a EmptyCtx -> Some (Assignment a)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Assignment a EmptyCtx
forall {k} (f :: k -> *). Assignment f EmptyCtx
Ctx.empty))
  where
    go :: Some (Ctx.Assignment a) -> m (Some (Ctx.Assignment a))
    go :: Some (Assignment a) -> m (Some (Assignment a))
go args :: Some (Assignment a)
args@(Some Assignment a x
prev) =
      Text -> m (Some (Assignment a)) -> m (Some (Assignment a))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
desc (m (Some (Assignment a)) -> m (Some (Assignment a)))
-> m (Some (Assignment a)) -> m (Some (Assignment a))
forall a b. (a -> b) -> a -> b
$
        (m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList m () -> m (Some (Assignment a)) -> m (Some (Assignment a))
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Some (Assignment a) -> m (Some (Assignment a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Some (Assignment a)
args) m (Some (Assignment a))
-> m (Some (Assignment a)) -> m (Some (Assignment a))
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (m (Some a)
-> (Some a -> m (Some (Assignment a))) -> m (Some (Assignment a))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (Some a)
sub ((Some a -> m (Some (Assignment a))) -> m (Some (Assignment a)))
-> (Some a -> m (Some (Assignment a))) -> m (Some (Assignment a))
forall a b. (a -> b) -> a -> b
$
           \(Some a x
a) ->
             Some (Assignment a) -> m (Some (Assignment a))
go (Assignment a (x ::> x) -> Some (Assignment a)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Assignment a (x ::> x) -> Some (Assignment a))
-> Assignment a (x ::> x) -> Some (Assignment a)
forall a b. (a -> b) -> a -> b
$ Assignment a x -> a x -> Assignment a (x ::> x)
forall {k} (f :: k -> *) (ctx :: Ctx k) (x :: k).
Assignment f ctx -> f x -> Assignment f (ctx ::> x)
Ctx.extend Assignment a x
prev a x
a))

arguments' :: forall m ext
            . ( MonadSyntax Atomic m, ?parserHooks :: ParserHooks ext )
           => m (Some (Ctx.Assignment Arg))
arguments' :: forall (m :: * -> *) ext.
(MonadSyntax Atomic m, ?parserHooks::ParserHooks ext) =>
m (Some (Assignment Arg))
arguments' = Text -> m (Some Arg) -> m (Some (Assignment Arg))
forall {k} (m :: * -> *) ext (a :: k -> *).
(MonadSyntax Atomic m, ?parserHooks::ParserHooks ext) =>
Text -> m (Some a) -> m (Some (Assignment a))
someAssign Text
"argument list" m (Some Arg)
oneArg
  where oneArg :: m (Some Arg)
oneArg =
          (Text
-> m (Posd (AtomName, (Some TypeRepr, ())))
-> m (Posd (AtomName, (Some TypeRepr, ())))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"argument" (m (Posd (AtomName, (Some TypeRepr, ())))
 -> m (Posd (AtomName, (Some TypeRepr, ()))))
-> m (Posd (AtomName, (Some TypeRepr, ())))
-> m (Posd (AtomName, (Some TypeRepr, ())))
forall a b. (a -> b) -> a -> b
$
           m (AtomName, (Some TypeRepr, ()))
-> m (Posd (AtomName, (Some TypeRepr, ())))
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
m a -> m (Posd a)
located (m (AtomName, (Some TypeRepr, ()))
 -> m (Posd (AtomName, (Some TypeRepr, ()))))
-> m (AtomName, (Some TypeRepr, ()))
-> m (Posd (AtomName, (Some TypeRepr, ())))
forall a b. (a -> b) -> a -> b
$
           m AtomName
-> m (Some TypeRepr, ()) -> m (AtomName, (Some TypeRepr, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m AtomName
forall (m :: * -> *). MonadSyntax Atomic m => m AtomName
atomName (m (Some TypeRepr) -> m () -> m (Some TypeRepr, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType m ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList)) m (Posd (AtomName, (Some TypeRepr, ())))
-> (Posd (AtomName, (Some TypeRepr, ())) -> Some Arg)
-> m (Some Arg)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
          \(Posd Position
loc (AtomName
x, (Some TypeRepr x
t, ()))) -> Arg x -> Some Arg
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (AtomName -> Position -> TypeRepr x -> Arg x
forall (t :: CrucibleType).
AtomName -> Position -> TypeRepr t -> Arg t
Arg AtomName
x Position
loc TypeRepr x
t)


saveArgs :: (MonadState (SyntaxState s) m, MonadError (ExprErr s) m)
         => Ctx.Assignment Arg init
         -> Ctx.Assignment (Atom s) init
         -> m ()
saveArgs :: forall s (m :: * -> *) (init :: Ctx CrucibleType).
(MonadState (SyntaxState s) m, MonadError (ExprErr s) m) =>
Assignment Arg init -> Assignment (Atom s) init -> m ()
saveArgs Assignment Arg init
ctx1 Assignment (Atom s) init
ctx2 =
  let combined :: Assignment
  (Const
     (Some
        (Product (Const AtomName) (Product (Const Position) (Atom s)))))
  init
combined = (forall (x :: CrucibleType).
 Arg x
 -> Atom s x
 -> Const
      (Some
         (Product (Const AtomName) (Product (Const Position) (Atom s))))
      x)
-> Assignment Arg init
-> Assignment (Atom s) init
-> Assignment
     (Const
        (Some
           (Product (Const AtomName) (Product (Const Position) (Atom s)))))
     init
forall {k} (f :: k -> *) (g :: k -> *) (h :: k -> *) (a :: Ctx k).
(forall (x :: k). f x -> g x -> h x)
-> Assignment f a -> Assignment g a -> Assignment h a
Ctx.zipWith
                   (\(Arg AtomName
x Position
p TypeRepr x
_) Atom s x
argAtom ->
                      (Some (Product (Const AtomName) (Product (Const Position) (Atom s)))
-> Const
     (Some
        (Product (Const AtomName) (Product (Const Position) (Atom s))))
     x
forall {k} a (b :: k). a -> Const a b
Const (Product (Const AtomName) (Product (Const Position) (Atom s)) x
-> Some
     (Product (Const AtomName) (Product (Const Position) (Atom s)))
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Const AtomName x
-> Product (Const Position) (Atom s) x
-> Product (Const AtomName) (Product (Const Position) (Atom s)) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Functor.Pair (AtomName -> Const AtomName x
forall {k} a (b :: k). a -> Const a b
Const AtomName
x) (Const Position x -> Atom s x -> Product (Const Position) (Atom s) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Functor.Pair (Position -> Const Position x
forall {k} a (b :: k). a -> Const a b
Const Position
p) Atom s x
argAtom)))))
                   Assignment Arg init
ctx1 Assignment (Atom s) init
ctx2
  in Assignment
  (Const
     (Some
        (Product (Const AtomName) (Product (Const Position) (Atom s)))))
  init
-> (forall {x :: CrucibleType}.
    Const
      (Some
         (Product (Const AtomName) (Product (Const Position) (Atom s))))
      x
    -> m ())
-> m ()
forall {k} {l} (t :: (k -> *) -> l -> *) (m :: * -> *)
       (f :: k -> *) (c :: l) a.
(FoldableFC t, Applicative m) =>
t f c -> (forall (x :: k). f x -> m a) -> m ()
forFC_ Assignment
  (Const
     (Some
        (Product (Const AtomName) (Product (Const Position) (Atom s)))))
  init
combined ((forall {x :: CrucibleType}.
  Const
    (Some
       (Product (Const AtomName) (Product (Const Position) (Atom s))))
    x
  -> m ())
 -> m ())
-> (forall {x :: CrucibleType}.
    Const
      (Some
         (Product (Const AtomName) (Product (Const Position) (Atom s))))
      x
    -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$
       \(Const (Some (Functor.Pair (Const AtomName
x) (Functor.Pair (Const Position
argPos) Atom s x
y)))) ->
         Lens' (SyntaxState s) (Maybe (Some (Atom s)))
-> (Maybe (Some (Atom s)) -> m ()) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
Lens' s a -> (a -> m b) -> m b
with ((Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
-> SyntaxState s -> f (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
-> SyntaxState s -> f (SyntaxState s)
stxAtoms ((Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
 -> SyntaxState s -> f (SyntaxState s))
-> ((Maybe (Some (Atom s)) -> f (Maybe (Some (Atom s))))
    -> Map AtomName (Some (Atom s))
    -> f (Map AtomName (Some (Atom s))))
-> (Maybe (Some (Atom s)) -> f (Maybe (Some (Atom s))))
-> SyntaxState s
-> f (SyntaxState s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map AtomName (Some (Atom s)))
-> Lens'
     (Map AtomName (Some (Atom s)))
     (Maybe (IxValue (Map AtomName (Some (Atom s)))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map AtomName (Some (Atom s)))
AtomName
x) ((Maybe (Some (Atom s)) -> m ()) -> m ())
-> (Maybe (Some (Atom s)) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
           \case
             Just Some (Atom s)
_ -> ExprErr s -> m ()
forall a. ExprErr s -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExprErr s -> m ()) -> ExprErr s -> m ()
forall a b. (a -> b) -> a -> b
$ Position -> AtomName -> ExprErr s
forall {k} (s :: k). Position -> AtomName -> ExprErr s
DuplicateAtom Position
argPos AtomName
x
             Maybe (Some (Atom s))
Nothing ->
               do (Map AtomName (Some (Atom s))
 -> Identity (Map AtomName (Some (Atom s))))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
-> SyntaxState s -> f (SyntaxState s)
stxAtoms ((Map AtomName (Some (Atom s))
  -> Identity (Map AtomName (Some (Atom s))))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map AtomName (Some (Atom s)) -> Map AtomName (Some (Atom s)))
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= AtomName
-> Some (Atom s)
-> Map AtomName (Some (Atom s))
-> Map AtomName (Some (Atom s))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AtomName
x (Atom s x -> Some (Atom s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Atom s x
y)

data FunctionHeader =
  forall args ret .
  FunctionHeader { FunctionHeader -> FunctionName
_headerName :: FunctionName
                 , ()
_headerArgs :: Ctx.Assignment Arg args
                 , ()
_headerReturnType :: TypeRepr ret
                 , ()
_headerHandle :: FnHandle args ret
                 , FunctionHeader -> Position
_headerLoc :: Position
                 }

data FunctionSource s =
  FunctionSource { forall {k} (s :: k). FunctionSource s -> [AST s]
_functionRegisters :: [AST s]
                 , forall {k} (s :: k). FunctionSource s -> AST s
_functionBody :: AST s
                 }

functionHeader' :: ( MonadSyntax Atomic m, ?parserHooks :: ParserHooks ext )
                => m ( (FunctionName, Some (Ctx.Assignment Arg), Some TypeRepr, Position)
                     , FunctionSource s
                     )
functionHeader' :: forall {k} (m :: * -> *) ext (s :: k).
(MonadSyntax Atomic m, ?parserHooks::ParserHooks ext) =>
m ((FunctionName, Some (Assignment Arg), Some TypeRepr, Position),
   FunctionSource s)
functionHeader' =
  do (FunctionName
fnName, (Some Assignment Arg x
theArgs, (Some TypeRepr x
ret, ([AST s]
regs, AST s
body)))) <-
       m ()
-> m (FunctionName,
      (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s))))
-> m (FunctionName,
      (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s))))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Defun) (m (FunctionName,
    (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s))))
 -> m (FunctionName,
       (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s)))))
-> m (FunctionName,
      (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s))))
-> m (FunctionName,
      (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s))))
forall a b. (a -> b) -> a -> b
$
       m FunctionName
-> m (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s)))
-> m (FunctionName,
      (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s))))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m FunctionName
forall (m :: * -> *). MonadSyntax Atomic m => m FunctionName
funName (m (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s)))
 -> m (FunctionName,
       (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s)))))
-> m (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s)))
-> m (FunctionName,
      (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s))))
forall a b. (a -> b) -> a -> b
$
       m (Some (Assignment Arg))
-> m (Some TypeRepr, ([AST s], AST s))
-> m (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s)))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m (Some (Assignment Arg))
forall (m :: * -> *) ext.
(MonadSyntax Atomic m, ?parserHooks::ParserHooks ext) =>
m (Some (Assignment Arg))
arguments' (m (Some TypeRepr, ([AST s], AST s))
 -> m (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s))))
-> m (Some TypeRepr, ([AST s], AST s))
-> m (Some (Assignment Arg), (Some TypeRepr, ([AST s], AST s)))
forall a b. (a -> b) -> a -> b
$
       m (Some TypeRepr)
-> m ([AST s], AST s) -> m (Some TypeRepr, ([AST s], AST s))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType (m ([AST s], AST s) -> m (Some TypeRepr, ([AST s], AST s)))
-> m ([AST s], AST s) -> m (Some TypeRepr, ([AST s], AST s))
forall a b. (a -> b) -> a -> b
$
       m [AST s] -> m (AST s) -> m ([AST s], AST s)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons m [AST s]
registers m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything m ([AST s], AST s) -> m ([AST s], AST s) -> m ([AST s], AST s)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([], ) (AST s -> ([AST s], AST s)) -> m (AST s) -> m ([AST s], AST s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
     Position
loc <- m Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
     ((FunctionName, Some (Assignment Arg), Some TypeRepr, Position),
 FunctionSource s)
-> m ((FunctionName, Some (Assignment Arg), Some TypeRepr,
       Position),
      FunctionSource s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((FunctionName
fnName, Assignment Arg x -> Some (Assignment Arg)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Assignment Arg x
theArgs, TypeRepr x -> Some TypeRepr
forall k (f :: k -> *) (x :: k). f x -> Some f
Some TypeRepr x
ret, Position
loc), [AST s] -> AST s -> FunctionSource s
forall {k} (s :: k). [AST s] -> AST s -> FunctionSource s
FunctionSource [AST s]
regs AST s
body)
  where
    registers :: m [AST s]
registers = m [AST s] -> m [AST s]
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (m [AST s] -> m [AST s]) -> m [AST s] -> m [AST s]
forall a b. (a -> b) -> a -> b
$ Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Registers m () -> m [AST s] -> m [AST s]
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
`followedBy` m [AST s]
forall atom (m :: * -> *). MonadSyntax atom m => m [Syntax atom]
anyList

functionHeader :: (?parserHooks :: ParserHooks ext)
               => AST s
               -> TopParser s (FunctionHeader, FunctionSource s)
functionHeader :: forall ext s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s (FunctionHeader, FunctionSource s)
functionHeader AST s
defun =
  do ((FunctionName
fnName, Some Assignment Arg x
theArgs, Some TypeRepr x
ret, Position
loc), FunctionSource s
src) <- SyntaxParse
  Atomic
  ((FunctionName, Some (Assignment Arg), Some TypeRepr, Position),
   FunctionSource s)
-> AST s
-> TopParser
     s
     ((FunctionName, Some (Assignment Arg), Some TypeRepr, Position),
      FunctionSource s)
forall {k} (s :: k) (m :: * -> *) a.
(MonadError (ExprErr s) m, MonadIO m) =>
SyntaxParse Atomic a -> AST s -> m a
liftSyntaxParse SyntaxParse
  Atomic
  ((FunctionName, Some (Assignment Arg), Some TypeRepr, Position),
   FunctionSource s)
forall {k} (m :: * -> *) ext (s :: k).
(MonadSyntax Atomic m, ?parserHooks::ParserHooks ext) =>
m ((FunctionName, Some (Assignment Arg), Some TypeRepr, Position),
   FunctionSource s)
functionHeader' AST s
defun
     HandleAllocator
ha <- Getting HandleAllocator (SyntaxState s) HandleAllocator
-> TopParser s HandleAllocator
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting HandleAllocator (SyntaxState s) HandleAllocator
 -> TopParser s HandleAllocator)
-> Getting HandleAllocator (SyntaxState s) HandleAllocator
-> TopParser s HandleAllocator
forall a b. (a -> b) -> a -> b
$ (ProgramState s -> Const HandleAllocator (ProgramState s))
-> SyntaxState s -> Const HandleAllocator (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState  ((ProgramState s -> Const HandleAllocator (ProgramState s))
 -> SyntaxState s -> Const HandleAllocator (SyntaxState s))
-> ((HandleAllocator -> Const HandleAllocator HandleAllocator)
    -> ProgramState s -> Const HandleAllocator (ProgramState s))
-> Getting HandleAllocator (SyntaxState s) HandleAllocator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HandleAllocator -> Const HandleAllocator HandleAllocator)
-> ProgramState s -> Const HandleAllocator (ProgramState s)
forall {k} (s :: k) (f :: * -> *).
Functor f =>
(HandleAllocator -> f HandleAllocator)
-> ProgramState s -> f (ProgramState s)
progHandleAlloc
     FnHandle x x
handle <- IO (FnHandle x x) -> TopParser s (FnHandle x x)
forall a. IO a -> TopParser s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FnHandle x x) -> TopParser s (FnHandle x x))
-> IO (FnHandle x x) -> TopParser s (FnHandle x x)
forall a b. (a -> b) -> a -> b
$ HandleAllocator
-> FunctionName
-> Assignment TypeRepr x
-> TypeRepr x
-> IO (FnHandle x x)
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
HandleAllocator
-> FunctionName
-> Assignment TypeRepr args
-> TypeRepr ret
-> IO (FnHandle args ret)
mkHandle' HandleAllocator
ha FunctionName
fnName (Assignment Arg x -> Assignment TypeRepr x
forall (init :: Ctx CrucibleType).
Assignment Arg init -> Assignment TypeRepr init
argTypes Assignment Arg x
theArgs) TypeRepr x
ret
     let header :: FunctionHeader
header = FunctionName
-> Assignment Arg x
-> TypeRepr x
-> FnHandle x x
-> Position
-> FunctionHeader
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FunctionName
-> Assignment Arg args
-> TypeRepr ret
-> FnHandle args ret
-> Position
-> FunctionHeader
FunctionHeader FunctionName
fnName Assignment Arg x
theArgs TypeRepr x
ret FnHandle x x
handle Position
loc

     FunctionName -> FunctionHeader -> TopParser s ()
forall {s} {m :: * -> *}.
MonadState (SyntaxState s) m =>
FunctionName -> FunctionHeader -> m ()
saveHeader FunctionName
fnName FunctionHeader
header
     (FunctionHeader, FunctionSource s)
-> TopParser s (FunctionHeader, FunctionSource s)
forall a. a -> TopParser s a
forall (m :: * -> *) a. Monad m => a -> m a
return ((FunctionHeader, FunctionSource s)
 -> TopParser s (FunctionHeader, FunctionSource s))
-> (FunctionHeader, FunctionSource s)
-> TopParser s (FunctionHeader, FunctionSource s)
forall a b. (a -> b) -> a -> b
$ (FunctionHeader
header, FunctionSource s
src)
  where
    saveHeader :: FunctionName -> FunctionHeader -> m ()
saveHeader FunctionName
n FunctionHeader
h =
      (Map FunctionName FunctionHeader
 -> Identity (Map FunctionName FunctionHeader))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> SyntaxState s -> f (SyntaxState s)
stxFunctions ((Map FunctionName FunctionHeader
  -> Identity (Map FunctionName FunctionHeader))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map FunctionName FunctionHeader
    -> Map FunctionName FunctionHeader)
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FunctionName
-> FunctionHeader
-> Map FunctionName FunctionHeader
-> Map FunctionName FunctionHeader
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
n FunctionHeader
h




global :: (?parserHooks :: ParserHooks ext)
       => AST s
       -> TopParser s (Some GlobalVar)
global :: forall ext s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s (Some GlobalVar)
global AST s
stx =
  do (var :: GlobalName
var@(GlobalName Text
varName), Some TypeRepr x
t) <- SyntaxParse Atomic (GlobalName, Some TypeRepr)
-> AST s -> TopParser s (GlobalName, Some TypeRepr)
forall {k} (s :: k) (m :: * -> *) a.
(MonadError (ExprErr s) m, MonadIO m) =>
SyntaxParse Atomic a -> AST s -> m a
liftSyntaxParse (SyntaxParse Atomic (GlobalName, Some TypeRepr)
-> SyntaxParse Atomic (GlobalName, Some TypeRepr)
forall a. SyntaxParse Atomic a -> SyntaxParse Atomic a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (Keyword
-> SyntaxParse Atomic GlobalName
-> SyntaxParse Atomic (Some TypeRepr)
-> SyntaxParse Atomic (GlobalName, Some TypeRepr)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
DefGlobal SyntaxParse Atomic GlobalName
forall (m :: * -> *). MonadSyntax Atomic m => m GlobalName
globalName SyntaxParse Atomic (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType)) AST s
stx
     HandleAllocator
ha <- Getting HandleAllocator (SyntaxState s) HandleAllocator
-> TopParser s HandleAllocator
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting HandleAllocator (SyntaxState s) HandleAllocator
 -> TopParser s HandleAllocator)
-> Getting HandleAllocator (SyntaxState s) HandleAllocator
-> TopParser s HandleAllocator
forall a b. (a -> b) -> a -> b
$ (ProgramState s -> Const HandleAllocator (ProgramState s))
-> SyntaxState s -> Const HandleAllocator (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState  ((ProgramState s -> Const HandleAllocator (ProgramState s))
 -> SyntaxState s -> Const HandleAllocator (SyntaxState s))
-> ((HandleAllocator -> Const HandleAllocator HandleAllocator)
    -> ProgramState s -> Const HandleAllocator (ProgramState s))
-> Getting HandleAllocator (SyntaxState s) HandleAllocator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HandleAllocator -> Const HandleAllocator HandleAllocator)
-> ProgramState s -> Const HandleAllocator (ProgramState s)
forall {k} (s :: k) (f :: * -> *).
Functor f =>
(HandleAllocator -> f HandleAllocator)
-> ProgramState s -> f (ProgramState s)
progHandleAlloc
     GlobalVar x
v <- IO (GlobalVar x) -> TopParser s (GlobalVar x)
forall a. IO a -> TopParser s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GlobalVar x) -> TopParser s (GlobalVar x))
-> IO (GlobalVar x) -> TopParser s (GlobalVar x)
forall a b. (a -> b) -> a -> b
$ HandleAllocator -> Text -> TypeRepr x -> IO (GlobalVar x)
forall (tp :: CrucibleType).
HandleAllocator -> Text -> TypeRepr tp -> IO (GlobalVar tp)
freshGlobalVar HandleAllocator
ha Text
varName TypeRepr x
t
     let sv :: Some GlobalVar
sv = GlobalVar x -> Some GlobalVar
forall k (f :: k -> *) (x :: k). f x -> Some f
Some GlobalVar x
v
     (Map GlobalName (Some GlobalVar)
 -> Identity (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> f (SyntaxState s)
stxGlobals ((Map GlobalName (Some GlobalVar)
  -> Identity (Map GlobalName (Some GlobalVar)))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map GlobalName (Some GlobalVar)
    -> Map GlobalName (Some GlobalVar))
-> TopParser s ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= GlobalName
-> Some GlobalVar
-> Map GlobalName (Some GlobalVar)
-> Map GlobalName (Some GlobalVar)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert GlobalName
var Some GlobalVar
sv
     Some GlobalVar -> TopParser s (Some GlobalVar)
forall a. a -> TopParser s a
forall (m :: * -> *) a. Monad m => a -> m a
return Some GlobalVar
sv

-- | Parse a forward declaration.
declare :: (?parserHooks :: ParserHooks ext)
        => AST t
        -> TopParser s FunctionHeader
declare :: forall {k} ext (t :: k) s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s FunctionHeader
declare AST s
stx =
  do ((FunctionName
fnName, (Some Assignment Arg x
theArgs, (Some TypeRepr x
ret, ()))), Position
loc) <-
       SyntaxParse
  Atomic
  ((FunctionName, (Some (Assignment Arg), (Some TypeRepr, ()))),
   Position)
-> AST s
-> TopParser
     s
     ((FunctionName, (Some (Assignment Arg), (Some TypeRepr, ()))),
      Position)
forall {k} (s :: k) (m :: * -> *) a.
(MonadError (ExprErr s) m, MonadIO m) =>
SyntaxParse Atomic a -> AST s -> m a
liftSyntaxParse (do (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ())))
r <- SyntaxParse Atomic ()
-> SyntaxParse
     Atomic (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ())))
-> SyntaxParse
     Atomic (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ())))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> SyntaxParse Atomic ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Declare) (SyntaxParse
   Atomic (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ())))
 -> SyntaxParse
      Atomic
      (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ()))))
-> SyntaxParse
     Atomic (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ())))
-> SyntaxParse
     Atomic (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ())))
forall a b. (a -> b) -> a -> b
$
                                SyntaxParse Atomic FunctionName
-> SyntaxParse Atomic (Some (Assignment Arg), (Some TypeRepr, ()))
-> SyntaxParse
     Atomic (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ())))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons SyntaxParse Atomic FunctionName
forall (m :: * -> *). MonadSyntax Atomic m => m FunctionName
funName (SyntaxParse Atomic (Some (Assignment Arg), (Some TypeRepr, ()))
 -> SyntaxParse
      Atomic
      (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ()))))
-> SyntaxParse Atomic (Some (Assignment Arg), (Some TypeRepr, ()))
-> SyntaxParse
     Atomic (FunctionName, (Some (Assignment Arg), (Some TypeRepr, ())))
forall a b. (a -> b) -> a -> b
$
                                SyntaxParse Atomic (Some (Assignment Arg))
-> SyntaxParse Atomic (Some TypeRepr, ())
-> SyntaxParse Atomic (Some (Assignment Arg), (Some TypeRepr, ()))
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons SyntaxParse Atomic (Some (Assignment Arg))
forall (m :: * -> *) ext.
(MonadSyntax Atomic m, ?parserHooks::ParserHooks ext) =>
m (Some (Assignment Arg))
arguments' (SyntaxParse Atomic (Some TypeRepr, ())
 -> SyntaxParse Atomic (Some (Assignment Arg), (Some TypeRepr, ())))
-> SyntaxParse Atomic (Some TypeRepr, ())
-> SyntaxParse Atomic (Some (Assignment Arg), (Some TypeRepr, ()))
forall a b. (a -> b) -> a -> b
$
                                SyntaxParse Atomic (Some TypeRepr)
-> SyntaxParse Atomic () -> SyntaxParse Atomic (Some TypeRepr, ())
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m (a, b)
cons SyntaxParse Atomic (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType SyntaxParse Atomic ()
forall atom (m :: * -> *). MonadSyntax atom m => m ()
emptyList
                           Position
loc <- SyntaxParse Atomic Position
forall atom (m :: * -> *). MonadSyntax atom m => m Position
position
                           ((FunctionName, (Some (Assignment Arg), (Some TypeRepr, ()))),
 Position)
-> SyntaxParse
     Atomic
     ((FunctionName, (Some (Assignment Arg), (Some TypeRepr, ()))),
      Position)
forall a. a -> SyntaxParse Atomic a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FunctionName, (Some (Assignment Arg), (Some TypeRepr, ())))
r, Position
loc))
                       AST s
stx
     HandleAllocator
ha <- Getting HandleAllocator (SyntaxState s) HandleAllocator
-> TopParser s HandleAllocator
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting HandleAllocator (SyntaxState s) HandleAllocator
 -> TopParser s HandleAllocator)
-> Getting HandleAllocator (SyntaxState s) HandleAllocator
-> TopParser s HandleAllocator
forall a b. (a -> b) -> a -> b
$ (ProgramState s -> Const HandleAllocator (ProgramState s))
-> SyntaxState s -> Const HandleAllocator (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState ((ProgramState s -> Const HandleAllocator (ProgramState s))
 -> SyntaxState s -> Const HandleAllocator (SyntaxState s))
-> ((HandleAllocator -> Const HandleAllocator HandleAllocator)
    -> ProgramState s -> Const HandleAllocator (ProgramState s))
-> Getting HandleAllocator (SyntaxState s) HandleAllocator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HandleAllocator -> Const HandleAllocator HandleAllocator)
-> ProgramState s -> Const HandleAllocator (ProgramState s)
forall {k} (s :: k) (f :: * -> *).
Functor f =>
(HandleAllocator -> f HandleAllocator)
-> ProgramState s -> f (ProgramState s)
progHandleAlloc
     FnHandle x x
handle <- IO (FnHandle x x) -> TopParser s (FnHandle x x)
forall a. IO a -> TopParser s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FnHandle x x) -> TopParser s (FnHandle x x))
-> IO (FnHandle x x) -> TopParser s (FnHandle x x)
forall a b. (a -> b) -> a -> b
$ HandleAllocator
-> FunctionName
-> Assignment TypeRepr x
-> TypeRepr x
-> IO (FnHandle x x)
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
HandleAllocator
-> FunctionName
-> Assignment TypeRepr args
-> TypeRepr ret
-> IO (FnHandle args ret)
mkHandle' HandleAllocator
ha FunctionName
fnName (Assignment Arg x -> Assignment TypeRepr x
forall (init :: Ctx CrucibleType).
Assignment Arg init -> Assignment TypeRepr init
argTypes Assignment Arg x
theArgs) TypeRepr x
ret

     let header :: FunctionHeader
header = FunctionName
-> Assignment Arg x
-> TypeRepr x
-> FnHandle x x
-> Position
-> FunctionHeader
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FunctionName
-> Assignment Arg args
-> TypeRepr ret
-> FnHandle args ret
-> Position
-> FunctionHeader
FunctionHeader FunctionName
fnName Assignment Arg x
theArgs TypeRepr x
ret FnHandle x x
handle Position
loc
     (Map FunctionName FunctionHeader
 -> Identity (Map FunctionName FunctionHeader))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> SyntaxState s -> f (SyntaxState s)
stxForwardDecs ((Map FunctionName FunctionHeader
  -> Identity (Map FunctionName FunctionHeader))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map FunctionName FunctionHeader
    -> Map FunctionName FunctionHeader)
-> TopParser s ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FunctionName
-> FunctionHeader
-> Map FunctionName FunctionHeader
-> Map FunctionName FunctionHeader
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FunctionName
fnName FunctionHeader
header
     FunctionHeader -> TopParser s FunctionHeader
forall a. a -> TopParser s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FunctionHeader
header

-- | Parse an extern.
extern :: (?parserHooks :: ParserHooks ext)
       => AST s
       -> TopParser s (Some GlobalVar)
extern :: forall ext s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s (Some GlobalVar)
extern AST s
stx =
  do (var :: GlobalName
var@(GlobalName Text
varName), Some TypeRepr x
t) <- SyntaxParse Atomic (GlobalName, Some TypeRepr)
-> AST s -> TopParser s (GlobalName, Some TypeRepr)
forall {k} (s :: k) (m :: * -> *) a.
(MonadError (ExprErr s) m, MonadIO m) =>
SyntaxParse Atomic a -> AST s -> m a
liftSyntaxParse (SyntaxParse Atomic (GlobalName, Some TypeRepr)
-> SyntaxParse Atomic (GlobalName, Some TypeRepr)
forall a. SyntaxParse Atomic a -> SyntaxParse Atomic a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (Keyword
-> SyntaxParse Atomic GlobalName
-> SyntaxParse Atomic (Some TypeRepr)
-> SyntaxParse Atomic (GlobalName, Some TypeRepr)
forall (m :: * -> *) a b.
MonadSyntax Atomic m =>
Keyword -> m a -> m b -> m (a, b)
binary Keyword
Extern SyntaxParse Atomic GlobalName
forall (m :: * -> *). MonadSyntax Atomic m => m GlobalName
globalName SyntaxParse Atomic (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType)) AST s
stx
     HandleAllocator
ha <- Getting HandleAllocator (SyntaxState s) HandleAllocator
-> TopParser s HandleAllocator
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting HandleAllocator (SyntaxState s) HandleAllocator
 -> TopParser s HandleAllocator)
-> Getting HandleAllocator (SyntaxState s) HandleAllocator
-> TopParser s HandleAllocator
forall a b. (a -> b) -> a -> b
$ (ProgramState s -> Const HandleAllocator (ProgramState s))
-> SyntaxState s -> Const HandleAllocator (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState  ((ProgramState s -> Const HandleAllocator (ProgramState s))
 -> SyntaxState s -> Const HandleAllocator (SyntaxState s))
-> ((HandleAllocator -> Const HandleAllocator HandleAllocator)
    -> ProgramState s -> Const HandleAllocator (ProgramState s))
-> Getting HandleAllocator (SyntaxState s) HandleAllocator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HandleAllocator -> Const HandleAllocator HandleAllocator)
-> ProgramState s -> Const HandleAllocator (ProgramState s)
forall {k} (s :: k) (f :: * -> *).
Functor f =>
(HandleAllocator -> f HandleAllocator)
-> ProgramState s -> f (ProgramState s)
progHandleAlloc
     GlobalVar x
v <- IO (GlobalVar x) -> TopParser s (GlobalVar x)
forall a. IO a -> TopParser s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GlobalVar x) -> TopParser s (GlobalVar x))
-> IO (GlobalVar x) -> TopParser s (GlobalVar x)
forall a b. (a -> b) -> a -> b
$ HandleAllocator -> Text -> TypeRepr x -> IO (GlobalVar x)
forall (tp :: CrucibleType).
HandleAllocator -> Text -> TypeRepr tp -> IO (GlobalVar tp)
freshGlobalVar HandleAllocator
ha Text
varName TypeRepr x
t
     let sv :: Some GlobalVar
sv = GlobalVar x -> Some GlobalVar
forall k (f :: k -> *) (x :: k). f x -> Some f
Some GlobalVar x
v
     (Map GlobalName (Some GlobalVar)
 -> Identity (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> f (SyntaxState s)
stxExterns ((Map GlobalName (Some GlobalVar)
  -> Identity (Map GlobalName (Some GlobalVar)))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map GlobalName (Some GlobalVar)
    -> Map GlobalName (Some GlobalVar))
-> TopParser s ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= GlobalName
-> Some GlobalVar
-> Map GlobalName (Some GlobalVar)
-> Map GlobalName (Some GlobalVar)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert GlobalName
var Some GlobalVar
sv
     Some GlobalVar -> TopParser s (Some GlobalVar)
forall a. a -> TopParser s a
forall (m :: * -> *) a. Monad m => a -> m a
return Some GlobalVar
sv

topLevel :: (?parserHooks :: ParserHooks ext)
         => AST s
         -> TopParser s (Maybe (FunctionHeader, FunctionSource s))
topLevel :: forall ext s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s (Maybe (FunctionHeader, FunctionSource s))
topLevel AST s
ast =
  ((FunctionHeader, FunctionSource s)
-> Maybe (FunctionHeader, FunctionSource s)
forall a. a -> Maybe a
Just ((FunctionHeader, FunctionSource s)
 -> Maybe (FunctionHeader, FunctionSource s))
-> TopParser s (FunctionHeader, FunctionSource s)
-> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AST s -> TopParser s (FunctionHeader, FunctionSource s)
forall ext s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s (FunctionHeader, FunctionSource s)
functionHeader AST s
ast) TopParser s (Maybe (FunctionHeader, FunctionSource s))
-> (ExprErr s
    -> TopParser s (Maybe (FunctionHeader, FunctionSource s)))
-> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall a.
TopParser s a -> (ExprErr s -> TopParser s a) -> TopParser s a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ExprErr s
e ->
  (AST s -> TopParser s (Some GlobalVar)
forall ext s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s (Some GlobalVar)
global AST s
ast TopParser s (Some GlobalVar)
-> Maybe (FunctionHeader, FunctionSource s)
-> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (FunctionHeader, FunctionSource s)
forall a. Maybe a
Nothing)       TopParser s (Maybe (FunctionHeader, FunctionSource s))
-> (ExprErr s
    -> TopParser s (Maybe (FunctionHeader, FunctionSource s)))
-> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall a.
TopParser s a -> (ExprErr s -> TopParser s a) -> TopParser s a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ExprErr s
_ ->
  (AST s -> TopParser s FunctionHeader
forall {k} ext (t :: k) s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s FunctionHeader
declare AST s
ast TopParser s FunctionHeader
-> Maybe (FunctionHeader, FunctionSource s)
-> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (FunctionHeader, FunctionSource s)
forall a. Maybe a
Nothing)      TopParser s (Maybe (FunctionHeader, FunctionSource s))
-> (ExprErr s
    -> TopParser s (Maybe (FunctionHeader, FunctionSource s)))
-> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall a.
TopParser s a -> (ExprErr s -> TopParser s a) -> TopParser s a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ExprErr s
_ ->
  (AST s -> TopParser s (Some GlobalVar)
forall ext s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s (Some GlobalVar)
extern AST s
ast TopParser s (Some GlobalVar)
-> Maybe (FunctionHeader, FunctionSource s)
-> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (FunctionHeader, FunctionSource s)
forall a. Maybe a
Nothing)       TopParser s (Maybe (FunctionHeader, FunctionSource s))
-> (ExprErr s
    -> TopParser s (Maybe (FunctionHeader, FunctionSource s)))
-> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall a.
TopParser s a -> (ExprErr s -> TopParser s a) -> TopParser s a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ExprErr s
_ ->
  ExprErr s -> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall a. ExprErr s -> TopParser s a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ExprErr s
e

argTypes :: Ctx.Assignment Arg init -> Ctx.Assignment TypeRepr init
argTypes :: forall (init :: Ctx CrucibleType).
Assignment Arg init -> Assignment TypeRepr init
argTypes  = (forall (x :: CrucibleType). Arg x -> TypeRepr x)
-> forall (init :: Ctx CrucibleType).
   Assignment Arg init -> Assignment TypeRepr init
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: CrucibleType -> *) (g :: CrucibleType -> *).
(forall (x :: CrucibleType). f x -> g x)
-> forall (x :: Ctx CrucibleType). Assignment f x -> Assignment g x
fmapFC (\(Arg AtomName
_ Position
_ TypeRepr x
t) -> TypeRepr x
t)


type BlockTodo s ret =
  (LabelName, BlockID s, Progress, AST s)

blocks :: forall s ret m ext
        . ( MonadState (SyntaxState s) m
          , MonadSyntax Atomic m
          , MonadIO m
          , TraverseExt ext
          , IsSyntaxExtension ext
          , ?parserHooks :: ParserHooks ext )
        => TypeRepr ret
        -> m [Block ext s ret]
blocks :: forall s (ret :: CrucibleType) (m :: * -> *) ext.
(MonadState (SyntaxState s) m, MonadSyntax Atomic m, MonadIO m,
 TraverseExt ext, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
TypeRepr ret -> m [Block ext s ret]
blocks TypeRepr ret
ret =
      m (BlockTodo s ret)
-> (BlockTodo s ret -> m [Block ext s ret]) -> m [Block ext s ret]
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m (BlockTodo s ret)
(MonadState (SyntaxState s) m, MonadSyntax Atomic m, MonadIO m) =>
m (BlockTodo s ret)
startBlock' ((BlockTodo s ret -> m [Block ext s ret]) -> m [Block ext s ret])
-> (BlockTodo s ret -> m [Block ext s ret]) -> m [Block ext s ret]
forall a b. (a -> b) -> a -> b
$
      \ BlockTodo s ret
startContents ->
        do [BlockTodo s ret]
todo <- m (BlockTodo s ret) -> m [BlockTodo s ret]
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m [a]
rep m (BlockTodo s ret)
blockLabel'
           [BlockTodo s ret]
-> (BlockTodo s ret -> m (Block ext s ret)) -> m [Block ext s ret]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (BlockTodo s ret
startContents BlockTodo s ret -> [BlockTodo s ret] -> [BlockTodo s ret]
forall a. a -> [a] -> [a]
: [BlockTodo s ret]
todo) ((BlockTodo s ret -> m (Block ext s ret)) -> m [Block ext s ret])
-> (BlockTodo s ret -> m (Block ext s ret)) -> m [Block ext s ret]
forall a b. (a -> b) -> a -> b
$ \(LabelName
_, BlockID s
bid, Progress
pr, AST s
stmts) ->
             do (Posd (TermStmt s ret)
term, [Posd (Stmt ext s)]
stmts') <- (Progress -> Progress)
-> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
-> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
forall a. (Progress -> Progress) -> m a -> m a
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
(Progress -> Progress) -> m a -> m a
withProgress (Progress -> Progress -> Progress
forall a b. a -> b -> a
const Progress
pr) (m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
 -> m (Posd (TermStmt s ret), [Posd (Stmt ext s)]))
-> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
-> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
forall a b. (a -> b) -> a -> b
$ AST s
-> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
-> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Syntax atom -> m a -> m a
parse AST s
stmts (m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
-> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (TypeRepr ret -> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
forall s (ret :: CrucibleType) (m :: * -> *) ext.
(MonadSyntax Atomic m, MonadState (SyntaxState s) m, MonadIO m,
 IsSyntaxExtension ext, ?parserHooks::ParserHooks ext) =>
TypeRepr ret -> m (Posd (TermStmt s ret), [Posd (Stmt ext s)])
blockBody' TypeRepr ret
ret))
                Block ext s ret -> m (Block ext s ret)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block ext s ret -> m (Block ext s ret))
-> Block ext s ret -> m (Block ext s ret)
forall a b. (a -> b) -> a -> b
$ BlockID s
-> ValueSet s
-> Seq (Posd (Stmt ext s))
-> Posd (TermStmt s ret)
-> Block ext s ret
forall ext s (ret :: CrucibleType).
TraverseExt ext =>
BlockID s
-> ValueSet s
-> Seq (Posd (Stmt ext s))
-> Posd (TermStmt s ret)
-> Block ext s ret
mkBlock BlockID s
bid ValueSet s
forall a. Monoid a => a
mempty ([Posd (Stmt ext s)] -> Seq (Posd (Stmt ext s))
forall a. [a] -> Seq a
Seq.fromList [Posd (Stmt ext s)]
stmts') Posd (TermStmt s ret)
term


  where

    startBlock' :: (MonadState (SyntaxState s) m, MonadSyntax Atomic m, MonadIO m) => m (BlockTodo s ret)
    startBlock' :: (MonadState (SyntaxState s) m, MonadSyntax Atomic m, MonadIO m) =>
m (BlockTodo s ret)
startBlock' =
      m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (m (BlockTodo s ret) -> m (BlockTodo s ret))
-> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a b. (a -> b) -> a -> b
$
      Text -> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall atom (m :: * -> *) a.
MonadSyntax atom m =>
Text -> m a -> m a
describe Text
"starting block" (m (BlockTodo s ret) -> m (BlockTodo s ret))
-> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a b. (a -> b) -> a -> b
$
      m () -> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
Start) (m (BlockTodo s ret) -> m (BlockTodo s ret))
-> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a b. (a -> b) -> a -> b
$
      m LabelName
-> (LabelName -> m (BlockTodo s ret)) -> m (BlockTodo s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m b) -> m b
depCons m LabelName
forall (m :: * -> *). MonadSyntax Atomic m => m LabelName
labelName ((LabelName -> m (BlockTodo s ret)) -> m (BlockTodo s ret))
-> (LabelName -> m (BlockTodo s ret)) -> m (BlockTodo s ret)
forall a b. (a -> b) -> a -> b
$
      \LabelName
l ->
        do Label s
lbl <- LabelName -> m (Label s)
forall s (m :: * -> *).
(MonadState (SyntaxState s) m, MonadIO m) =>
LabelName -> m (Label s)
newLabel LabelName
l
           Progress
pr <- m Progress
forall atom (m :: * -> *). MonadSyntax atom m => m Progress
progress
           AST s
rest <- m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
           BlockTodo s ret -> m (BlockTodo s ret)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelName
l, Label s -> BlockID s
forall s. Label s -> BlockID s
LabelID Label s
lbl, Progress
pr, AST s
rest)

    blockLabel' :: m (BlockTodo s ret)
    blockLabel' :: m (BlockTodo s ret)
blockLabel' =
      m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (m (BlockTodo s ret) -> m (BlockTodo s ret))
-> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a b. (a -> b) -> a -> b
$
      m () -> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> m b -> m b
followedBy (Keyword -> m ()
forall (m :: * -> *). MonadSyntax Atomic m => Keyword -> m ()
kw Keyword
DefBlock) (m (BlockTodo s ret) -> m (BlockTodo s ret))
-> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a b. (a -> b) -> a -> b
$
      m (BlockTodo s ret)
simpleBlock m (BlockTodo s ret) -> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (BlockTodo s ret)
argBlock
      where
        simpleBlock, argBlock :: m (BlockTodo s ret)
        simpleBlock :: m (BlockTodo s ret)
simpleBlock =
          m LabelName
-> (LabelName -> m (Either Text (BlockTodo s ret)))
-> m (BlockTodo s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m LabelName
forall (m :: * -> *). MonadSyntax Atomic m => m LabelName
labelName ((LabelName -> m (Either Text (BlockTodo s ret)))
 -> m (BlockTodo s ret))
-> (LabelName -> m (Either Text (BlockTodo s ret)))
-> m (BlockTodo s ret)
forall a b. (a -> b) -> a -> b
$
          \ LabelName
l ->
            do Map LabelName (LabelInfo s)
lbls <- Getting
  (Map LabelName (LabelInfo s))
  (SyntaxState s)
  (Map LabelName (LabelInfo s))
-> m (Map LabelName (LabelInfo s))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map LabelName (LabelInfo s))
  (SyntaxState s)
  (Map LabelName (LabelInfo s))
forall s (f :: * -> *).
Functor f =>
(Map LabelName (LabelInfo s) -> f (Map LabelName (LabelInfo s)))
-> SyntaxState s -> f (SyntaxState s)
stxLabels
               Progress
pr <- m Progress
forall atom (m :: * -> *). MonadSyntax atom m => m Progress
progress
               AST s
body <- m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
               case LabelName -> Map LabelName (LabelInfo s) -> Maybe (LabelInfo s)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup LabelName
l Map LabelName (LabelInfo s)
lbls of
                 Just LabelInfo s
_ -> Either Text (BlockTodo s ret) -> m (Either Text (BlockTodo s ret))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (BlockTodo s ret)
 -> m (Either Text (BlockTodo s ret)))
-> Either Text (BlockTodo s ret)
-> m (Either Text (BlockTodo s ret))
forall a b. (a -> b) -> a -> b
$ Text -> Either Text (BlockTodo s ret)
forall a b. a -> Either a b
Left Text
"unique label"
                 Maybe (LabelInfo s)
Nothing ->
                   do Label s
theLbl <- LabelName -> m (Label s)
forall s (m :: * -> *).
(MonadState (SyntaxState s) m, MonadIO m) =>
LabelName -> m (Label s)
newLabel LabelName
l
                      Either Text (BlockTodo s ret) -> m (Either Text (BlockTodo s ret))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (BlockTodo s ret)
 -> m (Either Text (BlockTodo s ret)))
-> Either Text (BlockTodo s ret)
-> m (Either Text (BlockTodo s ret))
forall a b. (a -> b) -> a -> b
$ BlockTodo s ret -> Either Text (BlockTodo s ret)
forall a b. b -> Either a b
Right (LabelName
l, Label s -> BlockID s
forall s. Label s -> BlockID s
LabelID Label s
theLbl, Progress
pr, AST s
body)
        argBlock :: m (BlockTodo s ret)
argBlock =
          m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a. m a -> m a
forall atom (m :: * -> *) a. MonadSyntax atom m => m a -> m a
call (m (BlockTodo s ret) -> m (BlockTodo s ret))
-> m (BlockTodo s ret) -> m (BlockTodo s ret)
forall a b. (a -> b) -> a -> b
$
          m (LabelName, Some (LambdaLabel s))
-> ((LabelName, Some (LambdaLabel s))
    -> m (Either Text (BlockTodo s ret)))
-> m (BlockTodo s ret)
forall atom (m :: * -> *) a b.
MonadSyntax atom m =>
m a -> (a -> m (Either Text b)) -> m b
depConsCond m (LabelName, Some (LambdaLabel s))
forall (m :: * -> *) s ext.
(MonadSyntax Atomic m, MonadState (SyntaxState s) m, MonadIO m,
 ?parserHooks::ParserHooks ext) =>
m (LabelName, Some (LambdaLabel s))
lambdaLabelBinding (((LabelName, Some (LambdaLabel s))
  -> m (Either Text (BlockTodo s ret)))
 -> m (BlockTodo s ret))
-> ((LabelName, Some (LambdaLabel s))
    -> m (Either Text (BlockTodo s ret)))
-> m (BlockTodo s ret)
forall a b. (a -> b) -> a -> b
$
          \ (LabelName
l, (Some LambdaLabel s x
lbl)) ->
            do Progress
pr <- m Progress
forall atom (m :: * -> *). MonadSyntax atom m => m Progress
progress
               AST s
body <- m (AST s)
forall atom (m :: * -> *). MonadSyntax atom m => m (Syntax atom)
anything
               Either Text (BlockTodo s ret) -> m (Either Text (BlockTodo s ret))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text (BlockTodo s ret)
 -> m (Either Text (BlockTodo s ret)))
-> Either Text (BlockTodo s ret)
-> m (Either Text (BlockTodo s ret))
forall a b. (a -> b) -> a -> b
$ BlockTodo s ret -> Either Text (BlockTodo s ret)
forall a b. b -> Either a b
Right (LabelName
l, LambdaLabel s x -> BlockID s
forall s (tp :: CrucibleType). LambdaLabel s tp -> BlockID s
LambdaID LambdaLabel s x
lbl, Progress
pr, AST s
body)

eval :: (MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m, MonadIO m, IsSyntaxExtension ext)
     => Position -> E ext s t -> m (Atom s t)
eval :: forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
_   (EAtom Atom s t
theAtom)  = Atom s t -> m (Atom s t)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Atom s t
theAtom -- The expression is already evaluated
eval Position
loc (EApp App ext (E ext s) t
e)         = Position -> AtomValue ext s t -> m (Atom s t)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (AtomValue ext s t -> m (Atom s t))
-> (App ext (Atom s) t -> AtomValue ext s t)
-> App ext (Atom s) t
-> m (Atom s t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. App ext (Atom s) t -> AtomValue ext s t
forall ext s (tp :: CrucibleType).
App ext (Atom s) tp -> AtomValue ext s tp
EvalApp (App ext (Atom s) t -> m (Atom s t))
-> m (App ext (Atom s) t) -> m (Atom s t)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (x :: CrucibleType). E ext s x -> m (Atom s x))
-> forall (x :: CrucibleType).
   App ext (E ext s) x -> m (App ext (Atom s) x)
forall k l (t :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (m :: * -> *).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: CrucibleType -> *) (g :: CrucibleType -> *)
       (m :: * -> *).
Applicative m =>
(forall (x :: CrucibleType). f x -> m (g x))
-> forall (x :: CrucibleType). App ext f x -> m (App ext g x)
traverseFC (Position -> E ext s x -> m (Atom s x)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
loc) App ext (E ext s) t
e
eval Position
_   (EReg Position
loc Reg s t
reg)   = Position -> AtomValue ext s t -> m (Atom s t)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (Reg s t -> AtomValue ext s t
forall s (tp :: CrucibleType) ext. Reg s tp -> AtomValue ext s tp
ReadReg Reg s t
reg)
eval Position
_   (EGlob Position
loc GlobalVar t
glob) = Position -> AtomValue ext s t -> m (Atom s t)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (GlobalVar t -> AtomValue ext s t
forall (tp :: CrucibleType) ext s.
GlobalVar tp -> AtomValue ext s tp
ReadGlobal GlobalVar t
glob)
eval Position
loc (EDeref Position
eloc E ext s (ReferenceType t)
e)  = Position -> AtomValue ext s t -> m (Atom s t)
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> AtomValue ext s t -> m (Atom s t)
freshAtom Position
loc (AtomValue ext s t -> m (Atom s t))
-> (Atom s (ReferenceType t) -> AtomValue ext s t)
-> Atom s (ReferenceType t)
-> m (Atom s t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Atom s (ReferenceType t) -> AtomValue ext s t
forall s (tp :: CrucibleType) ext.
Atom s (ReferenceType tp) -> AtomValue ext s tp
ReadRef (Atom s (ReferenceType t) -> m (Atom s t))
-> m (Atom s (ReferenceType t)) -> m (Atom s t)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Position
-> E ext s (ReferenceType t) -> m (Atom s (ReferenceType t))
forall ext s (m :: * -> *) (t :: CrucibleType).
(MonadWriter [Posd (Stmt ext s)] m, MonadState (SyntaxState s) m,
 MonadIO m, IsSyntaxExtension ext) =>
Position -> E ext s t -> m (Atom s t)
eval Position
eloc E ext s (ReferenceType t)
e

newtype TopParser s a =
  TopParser { forall s a.
TopParser s a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
runTopParser :: ExceptT (ExprErr s)
                                (StateT (SyntaxState s) IO)
                                a
            }
  deriving ((forall a b. (a -> b) -> TopParser s a -> TopParser s b)
-> (forall a b. a -> TopParser s b -> TopParser s a)
-> Functor (TopParser s)
forall a b. a -> TopParser s b -> TopParser s a
forall a b. (a -> b) -> TopParser s a -> TopParser s b
forall s a b. a -> TopParser s b -> TopParser s a
forall s a b. (a -> b) -> TopParser s a -> TopParser s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b. (a -> b) -> TopParser s a -> TopParser s b
fmap :: forall a b. (a -> b) -> TopParser s a -> TopParser s b
$c<$ :: forall s a b. a -> TopParser s b -> TopParser s a
<$ :: forall a b. a -> TopParser s b -> TopParser s a
Functor)

top :: NonceGenerator IO s -> HandleAllocator -> [(SomeHandle,Position)] -> TopParser s a -> IO (Either (ExprErr s) a)
top :: forall s a.
NonceGenerator IO s
-> HandleAllocator
-> [(SomeHandle, Position)]
-> TopParser s a
-> IO (Either (ExprErr s) a)
top NonceGenerator IO s
ng HandleAllocator
ha [(SomeHandle, Position)]
builtIns (TopParser (ExceptT (StateT SyntaxState s -> IO (Either (ExprErr s) a, SyntaxState s)
act))) =
  (Either (ExprErr s) a, SyntaxState s) -> Either (ExprErr s) a
forall a b. (a, b) -> a
fst ((Either (ExprErr s) a, SyntaxState s) -> Either (ExprErr s) a)
-> IO (Either (ExprErr s) a, SyntaxState s)
-> IO (Either (ExprErr s) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SyntaxState s -> IO (Either (ExprErr s) a, SyntaxState s)
act (NonceGenerator IO s -> ProgramState s -> SyntaxState s
forall s. NonceGenerator IO s -> ProgramState s -> SyntaxState s
initSyntaxState NonceGenerator IO s
ng ([(SomeHandle, Position)] -> HandleAllocator -> ProgramState s
forall {k} (s :: k).
[(SomeHandle, Position)] -> HandleAllocator -> ProgramState s
initProgState [(SomeHandle, Position)]
builtIns HandleAllocator
ha))

instance Applicative (TopParser s) where
  pure :: forall a. a -> TopParser s a
pure a
x = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser (a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a. a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  (TopParser ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (a -> b)
f) <*> :: forall a b. TopParser s (a -> b) -> TopParser s a -> TopParser s b
<*> (TopParser ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
x) = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b -> TopParser s b
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (a -> b)
f ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (a -> b)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall a b.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (a -> b)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
x)

instance Alternative (TopParser s) where
  empty :: forall a. TopParser s a
empty = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
 -> TopParser s a)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> TopParser s a
forall a b. (a -> b) -> a -> b
$ ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a.
ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Position -> ExprErr s
forall {k} (s :: k). Position -> ExprErr s
TrivialErr Position
InternalPos)
  (TopParser ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
x) <|> :: forall a. TopParser s a -> TopParser s a -> TopParser s a
<|> (TopParser ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
y) = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
x ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
y)

instance MonadPlus (TopParser s) where
  mzero :: forall a. TopParser s a
mzero = TopParser s a
forall a. TopParser s a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: forall a. TopParser s a -> TopParser s a -> TopParser s a
mplus = TopParser s a -> TopParser s a -> TopParser s a
forall a. TopParser s a -> TopParser s a -> TopParser s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Semigroup (TopParser s a) where
  <> :: TopParser s a -> TopParser s a -> TopParser s a
(<>) = TopParser s a -> TopParser s a -> TopParser s a
forall a. TopParser s a -> TopParser s a -> TopParser s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance Monoid (TopParser s a) where
  mempty :: TopParser s a
mempty = TopParser s a
forall a. TopParser s a
forall (f :: * -> *) a. Alternative f => f a
empty

instance Monad (TopParser s) where
  (TopParser ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
m) >>= :: forall a b. TopParser s a -> (a -> TopParser s b) -> TopParser s b
>>= a -> TopParser s b
f = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b -> TopParser s b
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
 -> TopParser s b)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
-> TopParser s b
forall a b. (a -> b) -> a -> b
$ ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
m ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> (a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall a b.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> (a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TopParser s b -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall s a.
TopParser s a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
runTopParser (TopParser s b
 -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b)
-> (a -> TopParser s b)
-> a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TopParser s b
f

instance MonadError (ExprErr s) (TopParser s) where
  throwError :: forall a. ExprErr s -> TopParser s a
throwError = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
 -> TopParser s a)
-> (ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> ExprErr s
-> TopParser s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a.
ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a.
TopParser s a -> (ExprErr s -> TopParser s a) -> TopParser s a
catchError TopParser s a
m ExprErr s -> TopParser s a
h = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
 -> TopParser s a)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> TopParser s a
forall a b. (a -> b) -> a -> b
$ ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> (ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
-> (ExprErr s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (TopParser s a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall s a.
TopParser s a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
runTopParser TopParser s a
m) (TopParser s a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall s a.
TopParser s a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
runTopParser (TopParser s a
 -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> (ExprErr s -> TopParser s a)
-> ExprErr s
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprErr s -> TopParser s a
h)

instance MonadState (SyntaxState s) (TopParser s) where
  get :: TopParser s (SyntaxState s)
get = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (SyntaxState s)
-> TopParser s (SyntaxState s)
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser ExceptT (ExprErr s) (StateT (SyntaxState s) IO) (SyntaxState s)
forall s (m :: * -> *). MonadState s m => m s
get
  put :: SyntaxState s -> TopParser s ()
put = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) ()
-> TopParser s ()
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) ()
 -> TopParser s ())
-> (SyntaxState s
    -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) ())
-> SyntaxState s
-> TopParser s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SyntaxState s -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance MonadIO (TopParser s) where
  liftIO :: forall a. IO a -> TopParser s a
liftIO = ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
forall s a.
ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a -> TopParser s a
TopParser (ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
 -> TopParser s a)
-> (IO a -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> IO a
-> TopParser s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (SyntaxState s) IO a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall (m :: * -> *) a. Monad m => m a -> ExceptT (ExprErr s) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (SyntaxState s) IO a
 -> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a)
-> (IO a -> StateT (SyntaxState s) IO a)
-> IO a
-> ExceptT (ExprErr s) (StateT (SyntaxState s) IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> StateT (SyntaxState s) IO a
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (SyntaxState s) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift


initParser :: forall s m ext
            . ( MonadState (SyntaxState s) m
              , MonadError (ExprErr s) m
              , MonadIO m
              , ?parserHooks :: ParserHooks ext )
           => FunctionHeader
           -> FunctionSource s
           -> m ()
initParser :: forall s (m :: * -> *) ext.
(MonadState (SyntaxState s) m, MonadError (ExprErr s) m, MonadIO m,
 ?parserHooks::ParserHooks ext) =>
FunctionHeader -> FunctionSource s -> m ()
initParser (FunctionHeader FunctionName
_ (Assignment Arg args
funArgs :: Ctx.Assignment Arg init) TypeRepr ret
_ FnHandle args ret
_ Position
_) (FunctionSource [AST s]
regs AST s
_) =
  do NonceGenerator IO s
ng <- Getting (NonceGenerator IO s) (SyntaxState s) (NonceGenerator IO s)
-> m (NonceGenerator IO s)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (NonceGenerator IO s) (SyntaxState s) (NonceGenerator IO s)
forall s (f :: * -> *).
(Contravariant f, Functor f) =>
(NonceGenerator IO s -> f (NonceGenerator IO s))
-> SyntaxState s -> f (SyntaxState s)
stxNonceGen
     ProgramState s
progState <- Getting (ProgramState s) (SyntaxState s) (ProgramState s)
-> m (ProgramState s)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (ProgramState s) (SyntaxState s) (ProgramState s)
forall s (f :: * -> *).
Functor f =>
(ProgramState s -> f (ProgramState s))
-> SyntaxState s -> f (SyntaxState s)
stxProgState
     SyntaxState s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SyntaxState s -> m ()) -> SyntaxState s -> m ()
forall a b. (a -> b) -> a -> b
$ NonceGenerator IO s -> ProgramState s -> SyntaxState s
forall s. NonceGenerator IO s -> ProgramState s -> SyntaxState s
initSyntaxState NonceGenerator IO s
ng ProgramState s
progState
     let types :: Assignment TypeRepr args
types = Assignment Arg args -> Assignment TypeRepr args
forall (init :: Ctx CrucibleType).
Assignment Arg init -> Assignment TypeRepr init
argTypes Assignment Arg args
funArgs
     Assignment (Atom s) args
inputAtoms <- IO (Assignment (Atom s) args) -> m (Assignment (Atom s) args)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Assignment (Atom s) args) -> m (Assignment (Atom s) args))
-> IO (Assignment (Atom s) args) -> m (Assignment (Atom s) args)
forall a b. (a -> b) -> a -> b
$ NonceGenerator IO s
-> Position
-> Assignment TypeRepr args
-> IO (Assignment (Atom s) args)
forall (m :: * -> *) s (init :: Ctx CrucibleType).
Monad m =>
NonceGenerator m s
-> Position -> CtxRepr init -> m (Assignment (Atom s) init)
mkInputAtoms NonceGenerator IO s
ng (Text -> Position
OtherPos Text
"args") Assignment TypeRepr args
types
     Assignment Arg args -> Assignment (Atom s) args -> m ()
forall s (m :: * -> *) (init :: Ctx CrucibleType).
(MonadState (SyntaxState s) m, MonadError (ExprErr s) m) =>
Assignment Arg init -> Assignment (Atom s) init -> m ()
saveArgs Assignment Arg args
funArgs Assignment (Atom s) args
inputAtoms
     [AST s] -> (AST s -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [AST s]
regs AST s -> m ()
saveRegister

  where
    saveRegister :: Syntax Atomic -> m ()
    saveRegister :: AST s -> m ()
saveRegister (L [A (Rg RegName
x), AST s
t]) =
      do Some TypeRepr x
ty <- SyntaxParse Atomic (Some TypeRepr) -> AST s -> m (Some TypeRepr)
forall {k} (s :: k) (m :: * -> *) a.
(MonadError (ExprErr s) m, MonadIO m) =>
SyntaxParse Atomic a -> AST s -> m a
liftSyntaxParse SyntaxParse Atomic (Some TypeRepr)
forall ext (m :: * -> *).
(?parserHooks::ParserHooks ext, MonadSyntax Atomic m) =>
m (Some TypeRepr)
isType AST s
t
         Reg s x
r <- TypeRepr x -> m (Reg s x)
forall s (m :: * -> *) (t :: CrucibleType).
(MonadState (SyntaxState s) m, MonadIO m) =>
TypeRepr t -> m (Reg s t)
newUnassignedReg TypeRepr x
ty
         (Map RegName (Some (Reg s))
 -> Identity (Map RegName (Some (Reg s))))
-> SyntaxState s -> Identity (SyntaxState s)
forall s (f :: * -> *).
Functor f =>
(Map RegName (Some (Reg s)) -> f (Map RegName (Some (Reg s))))
-> SyntaxState s -> f (SyntaxState s)
stxRegisters ((Map RegName (Some (Reg s))
  -> Identity (Map RegName (Some (Reg s))))
 -> SyntaxState s -> Identity (SyntaxState s))
-> (Map RegName (Some (Reg s)) -> Map RegName (Some (Reg s)))
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= RegName
-> Some (Reg s)
-> Map RegName (Some (Reg s))
-> Map RegName (Some (Reg s))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert RegName
x (Reg s x -> Some (Reg s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some Reg s x
r)
    saveRegister AST s
other = ExprErr s -> m ()
forall a. ExprErr s -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ExprErr s -> m ()) -> ExprErr s -> m ()
forall a b. (a -> b) -> a -> b
$ Position -> AST s -> ExprErr s
forall {k} (s :: k). Position -> AST s -> ExprErr s
InvalidRegister (AST s -> Position
forall a. Syntax a -> Position
syntaxPos AST s
other) AST s
other

cfgs :: ( IsSyntaxExtension ext
        , ?parserHooks :: ParserHooks ext )
     => [AST s]
     -> TopParser s [AnyCFG ext]
cfgs :: forall ext s.
(IsSyntaxExtension ext, ?parserHooks::ParserHooks ext) =>
[AST s] -> TopParser s [AnyCFG ext]
cfgs = (ParsedProgram ext -> [AnyCFG ext])
-> TopParser s (ParsedProgram ext) -> TopParser s [AnyCFG ext]
forall a b. (a -> b) -> TopParser s a -> TopParser s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsedProgram ext -> [AnyCFG ext]
forall ext. ParsedProgram ext -> [AnyCFG ext]
parsedProgCFGs (TopParser s (ParsedProgram ext) -> TopParser s [AnyCFG ext])
-> ([AST s] -> TopParser s (ParsedProgram ext))
-> [AST s]
-> TopParser s [AnyCFG ext]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AST s] -> TopParser s (ParsedProgram ext)
forall ext s.
(TraverseExt ext, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
[AST s] -> TopParser s (ParsedProgram ext)
prog

prog :: ( TraverseExt ext
        , IsSyntaxExtension ext
        , ?parserHooks :: ParserHooks ext )
     => [AST s]
     -> TopParser s (ParsedProgram ext)
prog :: forall ext s.
(TraverseExt ext, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
[AST s] -> TopParser s (ParsedProgram ext)
prog [AST s]
defuns =
  do [(FunctionHeader, FunctionSource s)]
headers <- [Maybe (FunctionHeader, FunctionSource s)]
-> [(FunctionHeader, FunctionSource s)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (FunctionHeader, FunctionSource s)]
 -> [(FunctionHeader, FunctionSource s)])
-> TopParser s [Maybe (FunctionHeader, FunctionSource s)]
-> TopParser s [(FunctionHeader, FunctionSource s)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AST s -> TopParser s (Maybe (FunctionHeader, FunctionSource s)))
-> [AST s]
-> TopParser s [Maybe (FunctionHeader, FunctionSource s)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse AST s -> TopParser s (Maybe (FunctionHeader, FunctionSource s))
forall ext s.
(?parserHooks::ParserHooks ext) =>
AST s -> TopParser s (Maybe (FunctionHeader, FunctionSource s))
topLevel [AST s]
defuns
     [AnyCFG ext]
cs <- [(FunctionHeader, FunctionSource s)]
-> ((FunctionHeader, FunctionSource s) -> TopParser s (AnyCFG ext))
-> TopParser s [AnyCFG ext]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(FunctionHeader, FunctionSource s)]
headers (((FunctionHeader, FunctionSource s) -> TopParser s (AnyCFG ext))
 -> TopParser s [AnyCFG ext])
-> ((FunctionHeader, FunctionSource s) -> TopParser s (AnyCFG ext))
-> TopParser s [AnyCFG ext]
forall a b. (a -> b) -> a -> b
$
       \(hdr :: FunctionHeader
hdr@(FunctionHeader FunctionName
_ Assignment Arg args
_ TypeRepr ret
ret FnHandle args ret
handle Position
_), src :: FunctionSource s
src@(FunctionSource [AST s]
_ AST s
body)) ->
         do FunctionHeader -> FunctionSource s -> TopParser s ()
forall s (m :: * -> *) ext.
(MonadState (SyntaxState s) m, MonadError (ExprErr s) m, MonadIO m,
 ?parserHooks::ParserHooks ext) =>
FunctionHeader -> FunctionSource s -> m ()
initParser FunctionHeader
hdr FunctionSource s
src
            [Some (Atom s)]
args <- Map AtomName (Some (Atom s)) -> [Some (Atom s)]
forall a. Map AtomName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Map AtomName (Some (Atom s)) -> [Some (Atom s)])
-> TopParser s (Map AtomName (Some (Atom s)))
-> TopParser s [Some (Atom s)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Map AtomName (Some (Atom s)))
  (SyntaxState s)
  (Map AtomName (Some (Atom s)))
-> TopParser s (Map AtomName (Some (Atom s)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map AtomName (Some (Atom s)))
  (SyntaxState s)
  (Map AtomName (Some (Atom s)))
forall s (f :: * -> *).
Functor f =>
(Map AtomName (Some (Atom s)) -> f (Map AtomName (Some (Atom s))))
-> SyntaxState s -> f (SyntaxState s)
stxAtoms
            let ?returnType = ?returnType::TypeRepr ret
TypeRepr ret
ret
            SyntaxState s
st <- TopParser s (SyntaxState s)
forall s (m :: * -> *). MonadState s m => m s
get
            ([Block ext s ret]
theBlocks, SyntaxState s
st') <- SyntaxParse Atomic ([Block ext s ret], SyntaxState s)
-> AST s -> TopParser s ([Block ext s ret], SyntaxState s)
forall {k} (s :: k) (m :: * -> *) a.
(MonadError (ExprErr s) m, MonadIO m) =>
SyntaxParse Atomic a -> AST s -> m a
liftSyntaxParse (StateT (SyntaxState s) (SyntaxParse Atomic) [Block ext s ret]
-> SyntaxState s
-> SyntaxParse Atomic ([Block ext s ret], SyntaxState s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (TypeRepr ret
-> StateT (SyntaxState s) (SyntaxParse Atomic) [Block ext s ret]
forall s (ret :: CrucibleType) (m :: * -> *) ext.
(MonadState (SyntaxState s) m, MonadSyntax Atomic m, MonadIO m,
 TraverseExt ext, IsSyntaxExtension ext,
 ?parserHooks::ParserHooks ext) =>
TypeRepr ret -> m [Block ext s ret]
blocks TypeRepr ret
ret) SyntaxState s
st) AST s
body
            SyntaxState s -> TopParser s ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put SyntaxState s
st'
            let vs :: Set (Some (Value s))
vs = [Some (Value s)] -> Set (Some (Value s))
forall a. Ord a => [a] -> Set a
Set.fromList [ Value s x -> Some (Value s)
forall k (f :: k -> *) (x :: k). f x -> Some f
Some (Atom s x -> Value s x
forall s (tp :: CrucibleType). Atom s tp -> Value s tp
AtomValue Atom s x
a) | Some Atom s x
a <- [Some (Atom s)]
args ]
            case [Block ext s ret]
theBlocks of
              []       -> String -> TopParser s (AnyCFG ext)
forall a. HasCallStack => String -> a
error String
"found no blocks"
              (Block ext s ret
e:[Block ext s ret]
rest) ->
                do let entry :: Label s
entry = case Block ext s ret -> BlockID s
forall ext s (ret :: CrucibleType). Block ext s ret -> BlockID s
blockID Block ext s ret
e of
                                 LabelID Label s
lbl -> Label s
lbl
                                 LambdaID {} -> String -> Label s
forall a. HasCallStack => String -> a
error String
"initial block is lambda"
                       e' :: Block ext s ret
e' = BlockID s
-> Set (Some (Value s))
-> Seq (Posd (Stmt ext s))
-> Posd (TermStmt s ret)
-> Block ext s ret
forall ext s (ret :: CrucibleType).
TraverseExt ext =>
BlockID s
-> ValueSet s
-> Seq (Posd (Stmt ext s))
-> Posd (TermStmt s ret)
-> Block ext s ret
mkBlock (Block ext s ret -> BlockID s
forall ext s (ret :: CrucibleType). Block ext s ret -> BlockID s
blockID Block ext s ret
e) Set (Some (Value s))
vs (Block ext s ret -> Seq (Posd (Stmt ext s))
forall ext s (ret :: CrucibleType).
Block ext s ret -> Seq (Posd (Stmt ext s))
blockStmts Block ext s ret
e) (Block ext s ret -> Posd (TermStmt s ret)
forall ext s (ret :: CrucibleType).
Block ext s ret -> Posd (TermStmt s ret)
blockTerm Block ext s ret
e)
                   AnyCFG ext -> TopParser s (AnyCFG ext)
forall a. a -> TopParser s a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyCFG ext -> TopParser s (AnyCFG ext))
-> AnyCFG ext -> TopParser s (AnyCFG ext)
forall a b. (a -> b) -> a -> b
$ CFG ext s args ret -> AnyCFG ext
forall ext blocks (init :: Ctx CrucibleType) (ret :: CrucibleType).
CFG ext blocks init ret -> AnyCFG ext
AnyCFG (FnHandle args ret
-> Label s -> [Block ext s ret] -> CFG ext s args ret
forall ext s (init :: Ctx CrucibleType) (ret :: CrucibleType).
FnHandle init ret
-> Label s -> [Block ext s ret] -> CFG ext s init ret
CFG FnHandle args ret
handle Label s
entry (Block ext s ret
e' Block ext s ret -> [Block ext s ret] -> [Block ext s ret]
forall a. a -> [a] -> [a]
: [Block ext s ret]
rest))
     Map GlobalName (Some GlobalVar)
gs <- Getting
  (Map GlobalName (Some GlobalVar))
  (SyntaxState s)
  (Map GlobalName (Some GlobalVar))
-> TopParser s (Map GlobalName (Some GlobalVar))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map GlobalName (Some GlobalVar))
  (SyntaxState s)
  (Map GlobalName (Some GlobalVar))
forall s (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> f (SyntaxState s)
stxGlobals
     Map GlobalName (Some GlobalVar)
externs <- Getting
  (Map GlobalName (Some GlobalVar))
  (SyntaxState s)
  (Map GlobalName (Some GlobalVar))
-> TopParser s (Map GlobalName (Some GlobalVar))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Map GlobalName (Some GlobalVar))
  (SyntaxState s)
  (Map GlobalName (Some GlobalVar))
forall s (f :: * -> *).
Functor f =>
(Map GlobalName (Some GlobalVar)
 -> f (Map GlobalName (Some GlobalVar)))
-> SyntaxState s -> f (SyntaxState s)
stxExterns
     Map FunctionName SomeHandle
fds <- LensLike'
  (Const (Map FunctionName SomeHandle))
  (SyntaxState s)
  (Map FunctionName FunctionHeader)
-> (Map FunctionName FunctionHeader -> Map FunctionName SomeHandle)
-> TopParser s (Map FunctionName SomeHandle)
forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike'
  (Const (Map FunctionName SomeHandle))
  (SyntaxState s)
  (Map FunctionName FunctionHeader)
forall s (f :: * -> *).
Functor f =>
(Map FunctionName FunctionHeader
 -> f (Map FunctionName FunctionHeader))
-> SyntaxState s -> f (SyntaxState s)
stxForwardDecs ((Map FunctionName FunctionHeader -> Map FunctionName SomeHandle)
 -> TopParser s (Map FunctionName SomeHandle))
-> (Map FunctionName FunctionHeader -> Map FunctionName SomeHandle)
-> TopParser s (Map FunctionName SomeHandle)
forall a b. (a -> b) -> a -> b
$ (FunctionHeader -> SomeHandle)
-> Map FunctionName FunctionHeader -> Map FunctionName SomeHandle
forall a b. (a -> b) -> Map FunctionName a -> Map FunctionName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FunctionHeader -> SomeHandle)
 -> Map FunctionName FunctionHeader -> Map FunctionName SomeHandle)
-> (FunctionHeader -> SomeHandle)
-> Map FunctionName FunctionHeader
-> Map FunctionName SomeHandle
forall a b. (a -> b) -> a -> b
$
              \(FunctionHeader FunctionName
_ Assignment Arg args
_ TypeRepr ret
_ FnHandle args ret
handle Position
_) -> FnHandle args ret -> SomeHandle
forall (args :: Ctx CrucibleType) (ret :: CrucibleType).
FnHandle args ret -> SomeHandle
SomeHandle FnHandle args ret
handle
     ParsedProgram ext -> TopParser s (ParsedProgram ext)
forall a. a -> TopParser s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedProgram ext -> TopParser s (ParsedProgram ext))
-> ParsedProgram ext -> TopParser s (ParsedProgram ext)
forall a b. (a -> b) -> a -> b
$ ParsedProgram
       { parsedProgGlobals :: Map GlobalName (Some GlobalVar)
parsedProgGlobals = Map GlobalName (Some GlobalVar)
gs
       , parsedProgExterns :: Map GlobalName (Some GlobalVar)
parsedProgExterns = Map GlobalName (Some GlobalVar)
externs
       , parsedProgCFGs :: [AnyCFG ext]
parsedProgCFGs = [AnyCFG ext]
cs
       , parsedProgForwardDecs :: Map FunctionName SomeHandle
parsedProgForwardDecs = Map FunctionName SomeHandle
fds
       }