{-# LANGUAGE NoImplicitPrelude #-}
module Language.PureScript.DCE.Eval
( evaluate ) where
import Prelude hiding (mod)
import Control.Applicative ((<|>))
import Control.Exception (Exception (..), throw)
import Control.Monad
import Control.Monad.Writer
import Data.List (find)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Language.PureScript.DCE.Constants as C
import Safe (atMay)
import Language.PureScript.AST.Literals
import Language.PureScript.CoreFn
import Language.PureScript.DCE.Utils
import Language.PureScript.Names (Ident(..), ModuleName(..), Qualified(..), QualifiedBy(..))
import Language.PureScript.PSString
data EvalState
= NotYet
| Done
deriving (EvalState -> EvalState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvalState -> EvalState -> Bool
$c/= :: EvalState -> EvalState -> Bool
== :: EvalState -> EvalState -> Bool
$c== :: EvalState -> EvalState -> Bool
Eq, Int -> EvalState -> ShowS
[EvalState] -> ShowS
EvalState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalState] -> ShowS
$cshowList :: [EvalState] -> ShowS
show :: EvalState -> String
$cshow :: EvalState -> String
showsPrec :: Int -> EvalState -> ShowS
$cshowsPrec :: Int -> EvalState -> ShowS
Show)
data StackT frame =
EmptyStack
| ConsStack !frame !(StackT frame)
deriving (Int -> StackT frame -> ShowS
forall frame. Show frame => Int -> StackT frame -> ShowS
forall frame. Show frame => [StackT frame] -> ShowS
forall frame. Show frame => StackT frame -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackT frame] -> ShowS
$cshowList :: forall frame. Show frame => [StackT frame] -> ShowS
show :: StackT frame -> String
$cshow :: forall frame. Show frame => StackT frame -> String
showsPrec :: Int -> StackT frame -> ShowS
$cshowsPrec :: forall frame. Show frame => Int -> StackT frame -> ShowS
Show, forall a b. a -> StackT b -> StackT a
forall a b. (a -> b) -> StackT a -> StackT b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> StackT b -> StackT a
$c<$ :: forall a b. a -> StackT b -> StackT a
fmap :: forall a b. (a -> b) -> StackT a -> StackT b
$cfmap :: forall a b. (a -> b) -> StackT a -> StackT b
Functor)
type Stack = StackT [((Ident, Expr Ann), EvalState)]
data EvaluationError
= QualifiedExpresionError Ann (Qualified Ident) ![ModuleName]
| OutOfBoundArrayIndex Ann
| NotFoundRecordField Ann PSString
deriving Int -> EvaluationError -> ShowS
[EvaluationError] -> ShowS
EvaluationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluationError] -> ShowS
$cshowList :: [EvaluationError] -> ShowS
show :: EvaluationError -> String
$cshow :: EvaluationError -> String
showsPrec :: Int -> EvaluationError -> ShowS
$cshowsPrec :: Int -> EvaluationError -> ShowS
Show
instance Exception EvaluationError
pushStack :: [(Ident, Expr Ann)]
-> Stack
-> Stack
pushStack :: [(Ident, Expr Ann)] -> Stack -> Stack
pushStack [(Ident, Expr Ann)]
frame Stack
st = forall a b. (a -> b) -> [a] -> [b]
map (, EvalState
NotYet) [(Ident, Expr Ann)]
frame forall frame. frame -> StackT frame -> StackT frame
`ConsStack` Stack
st
lookupStack :: Ident
-> Stack
-> Maybe ((Ident, Expr Ann), EvalState)
lookupStack :: Ident -> Stack -> Maybe ((Ident, Expr Ann), EvalState)
lookupStack Ident
_i Stack
EmptyStack = forall a. Maybe a
Nothing
lookupStack Ident
i (ConsStack [((Ident, Expr Ann), EvalState)]
f Stack
fs) = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\((Ident
i', Expr Ann
_), EvalState
_) -> Ident
i forall a. Eq a => a -> a -> Bool
== Ident
i') [((Ident, Expr Ann), EvalState)]
f of
Maybe ((Ident, Expr Ann), EvalState)
Nothing -> Ident -> Stack -> Maybe ((Ident, Expr Ann), EvalState)
lookupStack Ident
i Stack
fs
Just ((Ident, Expr Ann), EvalState)
x -> forall a. a -> Maybe a
Just ((Ident, Expr Ann), EvalState)
x
markDone :: Ident -> Stack -> Stack
markDone :: Ident -> Stack -> Stack
markDone Ident
_ Stack
EmptyStack = forall frame. StackT frame
EmptyStack
markDone Ident
i (ConsStack [((Ident, Expr Ann), EvalState)]
l Stack
ls) =
case forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b}.
((Ident, b), EvalState)
-> ([((Ident, b), EvalState)], Bool)
-> ([((Ident, b), EvalState)], Bool)
fn ([], Bool
False) [((Ident, Expr Ann), EvalState)]
l of
([((Ident, Expr Ann), EvalState)]
l', Bool
True) -> forall frame. frame -> StackT frame -> StackT frame
ConsStack [((Ident, Expr Ann), EvalState)]
l' Stack
ls
([((Ident, Expr Ann), EvalState)]
l', Bool
False) -> forall frame. frame -> StackT frame -> StackT frame
ConsStack [((Ident, Expr Ann), EvalState)]
l' (Ident -> Stack -> Stack
markDone Ident
i Stack
ls)
where
fn :: ((Ident, b), EvalState)
-> ([((Ident, b), EvalState)], Bool)
-> ([((Ident, b), EvalState)], Bool)
fn x :: ((Ident, b), EvalState)
x@(a :: (Ident, b)
a@(Ident
i', b
_), EvalState
_) ([((Ident, b), EvalState)]
is, Bool
done)
| Ident
i forall a. Eq a => a -> a -> Bool
== Ident
i' = (((Ident, b)
a, EvalState
Done) forall a. a -> [a] -> [a]
: [((Ident, b), EvalState)]
is, Bool
True)
| Bool
otherwise = (((Ident, b), EvalState)
x forall a. a -> [a] -> [a]
: [((Ident, b), EvalState)]
is, Bool
done)
evaluate :: [Module Ann] -> [Module Ann]
evaluate :: [Module Ann] -> [Module Ann]
evaluate [Module Ann]
mods = Module Ann -> Module Ann
rewriteModule forall a b. (a -> b) -> [a] -> [b]
`map` [Module Ann]
mods
where
rewriteModule :: Module Ann -> Module Ann
rewriteModule :: Module Ann -> Module Ann
rewriteModule mod :: Module Ann
mod@Module{ ModuleName
moduleName :: forall a. Module a -> ModuleName
moduleName :: ModuleName
moduleName, [Bind Ann]
moduleDecls :: forall a. Module a -> [Bind a]
moduleDecls :: [Bind Ann]
moduleDecls } =
Module Ann
mod { moduleDecls :: [Bind Ann]
moduleDecls = ModuleName -> Bind Ann -> Bind Ann
rewriteBind ModuleName
moduleName forall a b. (a -> b) -> [a] -> [b]
`map` [Bind Ann]
moduleDecls }
rewriteBind :: ModuleName
-> Bind Ann -> Bind Ann
rewriteBind :: ModuleName -> Bind Ann -> Bind Ann
rewriteBind ModuleName
mn (NonRec Ann
a Ident
i Expr Ann
e) =
forall a. a -> Ident -> Expr a -> Bind a
NonRec Ann
a Ident
i (ModuleName -> Stack -> Expr Ann -> Expr Ann
rewriteExpr ModuleName
mn forall frame. StackT frame
EmptyStack Expr Ann
e)
rewriteBind ModuleName
mn (Rec [((Ann, Ident), Expr Ann)]
binds') =
forall a. [((a, Ident), Expr a)] -> Bind a
Rec [ ModuleName -> Stack -> Expr Ann -> Expr Ann
rewriteExpr ModuleName
mn Stack
stack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Ann, Ident), Expr Ann)
bind'
| ((Ann, Ident), Expr Ann)
bind' <- [((Ann, Ident), Expr Ann)]
binds'
]
where
stack :: Stack
stack = [(Ident, Expr Ann)] -> Stack -> Stack
pushStack ((\((Ann
_, Ident
i), Expr Ann
e) -> (Ident
i, Expr Ann
e)) forall a b. (a -> b) -> [a] -> [b]
`map` [((Ann, Ident), Expr Ann)]
binds')
forall frame. StackT frame
EmptyStack
pushBinders :: [Expr Ann] -> [Binder Ann] -> Stack -> Stack
pushBinders :: [Expr Ann] -> [Binder Ann] -> Stack -> Stack
pushBinders [Expr Ann]
es [Binder Ann]
bs = [(Ident, Expr Ann)] -> Stack -> Stack
pushStack (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Binder Ann, Expr Ann) -> [(Ident, Expr Ann)]
fn (forall a b. [a] -> [b] -> [(a, b)]
zip [Binder Ann]
bs [Expr Ann]
es))
where
fn :: (Binder Ann, Expr Ann) -> [(Ident, Expr Ann)]
fn :: (Binder Ann, Expr Ann) -> [(Ident, Expr Ann)]
fn (NullBinder Ann
_, Expr Ann
_ ) = []
fn (LiteralBinder Ann
_ Literal (Binder Ann)
_, Expr Ann
_) = []
fn (VarBinder Ann
_ Ident
i, Expr Ann
e) = [(Ident
i,Expr Ann
e)]
fn (ConstructorBinder Ann
_ Qualified (ProperName 'TypeName)
_ Qualified (ProperName 'ConstructorName)
_ [Binder Ann]
as, Expr Ann
e) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Binder Ann, Expr Ann) -> [(Ident, Expr Ann)]
fn (forall a b. [a] -> [b] -> [(a, b)]
zip [Binder Ann]
as (forall a. a -> [a]
repeat Expr Ann
e))
fn (NamedBinder Ann
_ Ident
i Binder Ann
b, Expr Ann
e) = (Ident
i, Expr Ann
e) forall a. a -> [a] -> [a]
: (Binder Ann, Expr Ann) -> [(Ident, Expr Ann)]
fn (Binder Ann
b, Expr Ann
e)
rewriteExpr :: ModuleName -> Stack
-> Expr Ann -> Expr Ann
rewriteExpr :: ModuleName -> Stack -> Expr Ann -> Expr Ann
rewriteExpr ModuleName
mn Stack
st c :: Expr Ann
c@(Case Ann
ann [Expr Ann]
es [CaseAlternative Ann]
cs) =
let es' :: [Maybe (Expr Ann)]
es' :: [Maybe (Expr Ann)]
es' = [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st forall a b. (a -> b) -> [a] -> [b]
`map` [Expr Ann]
es
in case forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Ann -> Maybe (Expr Ann)
fltLiteral) [Maybe (Expr Ann)]
es' of
Maybe [Expr Ann]
Nothing ->
forall a. a -> [Expr a] -> [CaseAlternative a] -> Expr a
Case Ann
ann [Expr Ann]
es
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter
([Maybe (Expr Ann)] -> [Binder Ann] -> Bool
fltBinders ((forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Expr Ann -> Maybe (Expr Ann)
fltLiteral) forall a b. (a -> b) -> [a] -> [b]
`map` [Maybe (Expr Ann)]
es') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CaseAlternative a -> [Binder a]
caseAlternativeBinders)
[CaseAlternative Ann]
cs
Just [Expr Ann]
es'' ->
case forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Expr Ann] -> CaseAlternative Ann -> First (CaseAlternative Ann)
fndCase [Expr Ann]
es'') [CaseAlternative Ann]
cs of
First Maybe (CaseAlternative Ann)
Nothing -> Expr Ann
c
First (Just (CaseAlternative [Binder Ann]
bs (Right Expr Ann
e)))
-> ModuleName -> Stack -> Expr Ann -> Expr Ann
rewriteExpr ModuleName
mn ([Expr Ann] -> [Binder Ann] -> Stack -> Stack
pushBinders [Expr Ann]
es'' [Binder Ann]
bs Stack
st) Expr Ann
e
First (Just (CaseAlternative [Binder Ann]
bs (Left [(Expr Ann, Expr Ann)]
gs)))
-> forall a. a -> [Expr a] -> [CaseAlternative a] -> Expr a
Case Ann
ann [Expr Ann]
es [forall a.
[Binder a]
-> Either [(Guard a, Guard a)] (Guard a) -> CaseAlternative a
CaseAlternative [Binder Ann]
bs (forall a b. a -> Either a b
Left (ModuleName
-> Stack -> [(Expr Ann, Expr Ann)] -> [(Expr Ann, Expr Ann)]
fltGuards ModuleName
mn ([Expr Ann] -> [Binder Ann] -> Stack -> Stack
pushBinders [Expr Ann]
es [Binder Ann]
bs Stack
st) [(Expr Ann, Expr Ann)]
gs))]
rewriteExpr ModuleName
mn Stack
st (Let Ann
ann [Bind Ann]
bs Expr Ann
e) =
forall a. a -> [Bind a] -> Expr a -> Expr a
Let Ann
ann [Bind Ann]
bs
(ModuleName -> Stack -> Expr Ann -> Expr Ann
rewriteExpr ModuleName
mn ([(Ident, Expr Ann)] -> Stack -> Stack
pushStack (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bind Ann -> [(Ident, Expr Ann)]
unBind [Bind Ann]
bs) Stack
st) Expr Ann
e)
rewriteExpr ModuleName
mn Stack
st e :: Expr Ann
e@Var{} =
case [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
e of
Just l :: Expr Ann
l@(Literal Ann
_ NumericLiteral{}) -> Expr Ann
l
Just l :: Expr Ann
l@(Literal Ann
_ CharLiteral{}) -> Expr Ann
l
Just l :: Expr Ann
l@(Literal Ann
_ BooleanLiteral{}) -> Expr Ann
l
Just Expr Ann
_ -> Expr Ann
e
Maybe (Expr Ann)
Nothing -> Expr Ann
e
rewriteExpr ModuleName
mn Stack
st Expr Ann
e =
case [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
e of
Just Expr Ann
l -> Expr Ann
l
Maybe (Expr Ann)
Nothing -> Expr Ann
e
fltBinders :: [Maybe (Expr Ann)]
-> [Binder Ann]
-> Bool
fltBinders :: [Maybe (Expr Ann)] -> [Binder Ann] -> Bool
fltBinders (Just (Literal Ann
_ Literal (Expr Ann)
l1) : [Maybe (Expr Ann)]
ts) (LiteralBinder Ann
_ Literal (Binder Ann)
l2 : [Binder Ann]
bs) =
Literal (Expr Ann)
l1 forall a b. Literal a -> Literal b -> Bool
`eqLit` Literal (Binder Ann)
l2 Bool -> Bool -> Bool
&& [Maybe (Expr Ann)] -> [Binder Ann] -> Bool
fltBinders [Maybe (Expr Ann)]
ts [Binder Ann]
bs
fltBinders [Maybe (Expr Ann)]
_ [Binder Ann]
_ = Bool
True
fltGuards
:: ModuleName
-> Stack
-> [(Guard Ann, Expr Ann)]
-> [(Guard Ann, Expr Ann)]
fltGuards :: ModuleName
-> Stack -> [(Expr Ann, Expr Ann)] -> [(Expr Ann, Expr Ann)]
fltGuards ModuleName
_ Stack
_ [] = []
fltGuards ModuleName
mn Stack
st (guard' :: (Expr Ann, Expr Ann)
guard'@(Expr Ann
g, Expr Ann
e) : [(Expr Ann, Expr Ann)]
rest) =
case [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
g of
Just (Literal Ann
_ Literal (Expr Ann)
t)
| Literal (Expr Ann)
t forall a b. Literal a -> Literal b -> Bool
`eqLit` forall a. Bool -> Literal a
BooleanLiteral Bool
True
-> [(forall a. a -> Literal (Expr a) -> Expr a
Literal (forall a. Expr a -> a
extractAnn Expr Ann
g) (forall a. Bool -> Literal a
BooleanLiteral Bool
True), Expr Ann
e)]
| Bool
otherwise
-> ModuleName
-> Stack -> [(Expr Ann, Expr Ann)] -> [(Expr Ann, Expr Ann)]
fltGuards ModuleName
mn Stack
st [(Expr Ann, Expr Ann)]
rest
Maybe (Expr Ann)
_ -> (Expr Ann, Expr Ann)
guard' forall a. a -> [a] -> [a]
: ModuleName
-> Stack -> [(Expr Ann, Expr Ann)] -> [(Expr Ann, Expr Ann)]
fltGuards ModuleName
mn Stack
st [(Expr Ann, Expr Ann)]
rest
fltLiteral :: Expr Ann -> Maybe (Expr Ann)
fltLiteral :: Expr Ann -> Maybe (Expr Ann)
fltLiteral e :: Expr Ann
e@Literal {} = forall a. a -> Maybe a
Just Expr Ann
e
fltLiteral Expr Ann
_ = forall a. Maybe a
Nothing
fndCase :: [Expr Ann] -> CaseAlternative Ann -> First (CaseAlternative Ann)
fndCase :: [Expr Ann] -> CaseAlternative Ann -> First (CaseAlternative Ann)
fndCase [Expr Ann]
as CaseAlternative Ann
c =
if [Expr Ann]
as [Expr Ann] -> [Binder Ann] -> Bool
`matches` forall a. CaseAlternative a -> [Binder a]
caseAlternativeBinders CaseAlternative Ann
c
then forall a. Maybe a -> First a
First (forall a. a -> Maybe a
Just CaseAlternative Ann
c)
else forall a. Maybe a -> First a
First forall a. Maybe a
Nothing
where
matches :: [Expr Ann] -> [Binder Ann] -> Bool
matches :: [Expr Ann] -> [Binder Ann] -> Bool
matches [] [] = Bool
True
matches [] [Binder Ann]
_ = forall a. HasCallStack => String -> a
error String
"impossible happend: not matching case expressions and case alternatives"
matches [Expr Ann]
_ [] = forall a. HasCallStack => String -> a
error String
"impossible happend: not matching case expressions and case alternatives"
matches (Literal Ann
_ Literal (Expr Ann)
t:[Expr Ann]
ts) (LiteralBinder Ann
_ Literal (Binder Ann)
t' : [Binder Ann]
bs) = Literal (Expr Ann)
t forall a b. Literal a -> Literal b -> Bool
`eqLit` Literal (Binder Ann)
t' Bool -> Bool -> Bool
&& [Expr Ann] -> [Binder Ann] -> Bool
matches [Expr Ann]
ts [Binder Ann]
bs
matches (Literal Ann
_ Literal (Expr Ann)
t:[Expr Ann]
ts) (NamedBinder Ann
_ Ident
_ (LiteralBinder Ann
_ Literal (Binder Ann)
t') : [Binder Ann]
bs) = Literal (Expr Ann)
t forall a b. Literal a -> Literal b -> Bool
`eqLit` Literal (Binder Ann)
t' Bool -> Bool -> Bool
&& [Expr Ann] -> [Binder Ann] -> Bool
matches [Expr Ann]
ts [Binder Ann]
bs
matches (Literal {}:[Expr Ann]
ts) (Binder Ann
_:[Binder Ann]
bs) = [Expr Ann] -> [Binder Ann] -> Bool
matches [Expr Ann]
ts [Binder Ann]
bs
matches (Expr Ann
_:[Expr Ann]
_) (Binder Ann
_:[Binder Ann]
_) = Bool
False
eval :: [Module Ann]
-> ModuleName
-> Stack
-> Expr Ann
-> Maybe (Expr Ann)
eval :: [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st (Var Ann
_ (Qualified (BySourcePos SourcePos
_) Ident
i)) =
case Ident -> Stack -> Maybe ((Ident, Expr Ann), EvalState)
lookupStack Ident
i Stack
st of
Maybe ((Ident, Expr Ann), EvalState)
Nothing -> forall a. Maybe a
Nothing
Just ((Ident
_, Expr Ann
e), EvalState
Done) -> forall a. a -> Maybe a
Just Expr Ann
e
Just ((Ident
_, Expr Ann
e), EvalState
NotYet) -> [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn (Ident -> Stack -> Stack
markDone Ident
i Stack
st) Expr Ann
e
eval [Module Ann]
mods ModuleName
mn Stack
st (Var Ann
ann qi :: Qualified Ident
qi@(Qualified (ByModuleName ModuleName
imn) Ident
i)) =
case [Module Ann] -> ModuleName -> Ident -> Maybe LookupResult
lookupQualifiedExpr [Module Ann]
mods ModuleName
imn Ident
i of
Maybe LookupResult
Nothing -> forall a e. Exception e => e -> a
throw (Ann -> Qualified Ident -> [ModuleName] -> EvaluationError
QualifiedExpresionError Ann
ann Qualified Ident
qi (forall a. Module a -> ModuleName
moduleName forall a b. (a -> b) -> [a] -> [b]
`map` [Module Ann]
mods))
Just (FoundExpr Expr Ann
e) -> [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
e
Just LookupResult
Found -> forall a. Maybe a
Nothing
eval [Module Ann]
mods ModuleName
mn Stack
st (Literal Ann
ann (ArrayLiteral [Expr Ann]
es)) =
let es' :: [Expr Ann]
es' = forall a b. (a -> b) -> [a] -> [b]
map (\Expr Ann
e -> forall a. a -> Maybe a -> a
fromMaybe Expr Ann
e forall a b. (a -> b) -> a -> b
$ [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
e) [Expr Ann]
es
in forall a. a -> Maybe a
Just (forall a. a -> Literal (Expr a) -> Expr a
Literal Ann
ann (forall a. [a] -> Literal a
ArrayLiteral [Expr Ann]
es'))
eval [Module Ann]
mods ModuleName
mn Stack
st (Literal Ann
ann (ObjectLiteral [(PSString, Expr Ann)]
as)) =
let as' :: [(PSString, Expr Ann)]
as' = forall a b. (a -> b) -> [a] -> [b]
map (\x :: (PSString, Expr Ann)
x@(PSString
n, Expr Ann
e) ->
case [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
e of
Maybe (Expr Ann)
Nothing -> (PSString, Expr Ann)
x
Just Expr Ann
e' -> (PSString
n, Expr Ann
e')
) [(PSString, Expr Ann)]
as
in forall a. a -> Maybe a
Just (forall a. a -> Literal (Expr a) -> Expr a
Literal Ann
ann (forall a. [(PSString, a)] -> Literal a
ObjectLiteral [(PSString, Expr Ann)]
as'))
eval [Module Ann]
_mods ModuleName
_mn Stack
_st e :: Expr Ann
e@Literal{} = forall a. a -> Maybe a
Just Expr Ann
e
eval [Module Ann]
mods ModuleName
mn Stack
st (Accessor Ann
ann PSString
a (Literal Ann
_ (ObjectLiteral [(PSString, Expr Ann)]
as))) =
case PSString
a forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(PSString, Expr Ann)]
as of
Maybe (Expr Ann)
Nothing -> forall a e. Exception e => e -> a
throw (Ann -> PSString -> EvaluationError
NotFoundRecordField Ann
ann PSString
a)
Just Expr Ann
e -> [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
e
eval [Module Ann]
mods ModuleName
mn Stack
st
(App Ann
ann
(App Ann
_
(App Ann
_
(Var Ann
_
(Qualified
(ByModuleName ModuleName
C.Eq)
(Ident Text
"eq")))
(Var Ann
_ Qualified Ident
inst))
Expr Ann
e1)
Expr Ann
e2) =
if Qualified Ident
inst forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
[ forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.eqMod) (Text -> Ident
Ident Text
"eqBoolean")
, forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.eqMod) (Text -> Ident
Ident Text
"eqInt")
, forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.eqMod) (Text -> Ident
Ident Text
"eqNumber")
, forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.eqMod) (Text -> Ident
Ident Text
"eqChar")
, forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.eqMod) (Text -> Ident
Ident Text
"eqString")
, forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.eqMod) (Text -> Ident
Ident Text
"eqUnit")
, forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.eqMod) (Text -> Ident
Ident Text
"eqVoid")
]
then case ([Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
e1, [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
e2) of
(Just (Literal Ann
_ Literal (Expr Ann)
l1), Just (Literal Ann
_ Literal (Expr Ann)
l2))
-> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal Ann
ann forall a b. (a -> b) -> a -> b
$ forall a. Bool -> Literal a
BooleanLiteral (forall a b. Literal a -> Literal b -> Bool
eqLit Literal (Expr Ann)
l1 Literal (Expr Ann)
l2)
(Maybe (Expr Ann), Maybe (Expr Ann))
_ -> forall a. Maybe a
Nothing
else forall a. Maybe a
Nothing
eval [Module Ann]
mods ModuleName
mn Stack
st
(App Ann
_
(App Ann
_
(Var ann :: Ann
ann@(SourceSpan
ss, [Comment]
_, Maybe SourceType
_, Maybe Meta
_)
(Qualified
(ByModuleName (ModuleName Text
"Data.Array"))
(Ident Text
"index")))
(Literal Ann
_ (ArrayLiteral [Expr Ann]
as)))
(Literal Ann
_ (NumericLiteral (Left Integer
x)))) =
case ([Expr Ann]
as forall a. [a] -> Int -> Maybe a
`atMay` forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x) of
Maybe (Expr Ann)
Nothing -> forall a e. Exception e => e -> a
throw (Ann -> EvaluationError
OutOfBoundArrayIndex Ann
ann)
Just Expr Ann
e -> case [Module Ann] -> ModuleName -> Stack -> Expr Ann -> Maybe (Expr Ann)
eval [Module Ann]
mods ModuleName
mn Stack
st Expr Ann
e of
Maybe (Expr Ann)
Nothing -> forall a. Maybe a
Nothing
Just Expr Ann
e' ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Expr a -> Expr a -> Expr a
App Ann
ann
(forall a. a -> Qualified Ident -> Expr a
Var (SourceSpan
ss, [], forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just (ConstructorType -> [Ident] -> Meta
IsConstructor ConstructorType
SumType [Text -> Ident
Ident Text
"value0"]))
(forall a. QualifiedBy -> a -> Qualified a
Qualified
(ModuleName -> QualifiedBy
ByModuleName ModuleName
C.maybeMod)
(Text -> Ident
Ident Text
"Just")))
Expr Ann
e'
eval [Module Ann]
_ ModuleName
_ms Stack
_st
(App Ann
ann
(App Ann
_
(App Ann
_
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.Semigroup) (Ident Text
"append")))
(Var Ann
_ Qualified Ident
qi))
Expr Ann
e1)
Expr Ann
e2)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semigroup) (Text -> Ident
Ident Text
"semigroupArray")
, Literal Ann
_ (ArrayLiteral [Expr Ann]
a1) <- Expr Ann
e1
, Literal Ann
_ (ArrayLiteral [Expr Ann]
a2) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal Ann
ann (forall a. [a] -> Literal a
ArrayLiteral forall a b. (a -> b) -> a -> b
$ [Expr Ann]
a1 forall a. [a] -> [a] -> [a]
++ [Expr Ann]
a2)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semigroup) (Text -> Ident
Ident Text
"semigroupString")
, Literal Ann
_ (StringLiteral PSString
s1) <- Expr Ann
e1
, Just Text
t1 <- PSString -> Maybe Text
decodeString PSString
s1
, Literal Ann
_ (StringLiteral PSString
s2) <- Expr Ann
e2
, Just Text
t2 <- PSString -> Maybe Text
decodeString PSString
s2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal Ann
ann (forall a. PSString -> Literal a
StringLiteral (Text -> PSString
mkString forall a b. (a -> b) -> a -> b
$ Text
t1 forall a. Semigroup a => a -> a -> a
<> Text
t2) )
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semigroup) (Text -> Ident
Ident Text
"semigroupUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var Ann
ann (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_ ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(App Ann
_
(App Ann
_
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.Semiring) (Ident Text
"add")))
(Var Ann
_ Qualified Ident
qi))
Expr Ann
e1)
Expr Ann
e2)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringInt")
, Literal Ann
_ (NumericLiteral (Left Integer
a1)) <- Expr Ann
e1
, Literal Ann
_ (NumericLiteral (Left Integer
a2)) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. a -> Either a b
Left (Integer
a1 forall a. Num a => a -> a -> a
+ Integer
a2)))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringNumber")
, Literal Ann
_ (NumericLiteral (Right Double
a1)) <- Expr Ann
e1
, Literal Ann
_ (NumericLiteral (Right Double
a2)) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. b -> Either a b
Right (Double
a1 forall a. Num a => a -> a -> a
+ Double
a2)))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_ ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.Semiring) (Ident Text
"zero")))
(Var Ann
_ Qualified Ident
qi))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringInt")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. a -> Either a b
Left Integer
0))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified
(ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring)
(Text -> Ident
Ident Text
"semiringNumber")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. b -> Either a b
Right Double
0.0))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_ ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.Semiring) (Ident Text
"one")))
(Var Ann
_ Qualified Ident
qi))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringInt")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. a -> Either a b
Left Integer
1))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringNumber")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. b -> Either a b
Right Double
1.0))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_ ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(App Ann
_
(App Ann
_
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.Semiring) (Ident Text
"mul")))
(Var Ann
_ Qualified Ident
qi))
Expr Ann
e1)
Expr Ann
e2)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringInt")
, Literal Ann
_ (NumericLiteral (Left Integer
a1)) <- Expr Ann
e1
, Literal Ann
_ (NumericLiteral (Left Integer
a2)) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. a -> Either a b
Left (Integer
a1 forall a. Num a => a -> a -> a
* Integer
a2)))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringNumber")
, Literal Ann
_ (NumericLiteral (Right Double
a1)) <- Expr Ann
e1
, Literal Ann
_ (NumericLiteral (Right Double
a2)) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. b -> Either a b
Right (Double
a1 forall a. Num a => a -> a -> a
* Double
a2)))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.semiring) (Text -> Ident
Ident Text
"semiringUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_ ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(App Ann
_
(App Ann
_
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.Ring) (Ident Text
"sub")))
(Var Ann
_ Qualified Ident
qi))
Expr Ann
e1)
Expr Ann
e2)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.ring) (Text -> Ident
Ident Text
"ringInt")
, Literal Ann
_ (NumericLiteral (Left Integer
a1)) <- Expr Ann
e1
, Literal Ann
_ (NumericLiteral (Left Integer
a2)) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. a -> Either a b
Left (forall a. Integral a => a -> a -> a
quot Integer
a1 Integer
a2)))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.ring) (Text -> Ident
Ident Text
"ringNumber")
, Literal Ann
_ (NumericLiteral (Right Double
a1)) <- Expr Ann
e1
, Literal Ann
_ (NumericLiteral (Right Double
a2)) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. b -> Either a b
Right (Double
a1 forall a. Fractional a => a -> a -> a
/ Double
a2)))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.ring) (Text -> Ident
Ident Text
"unitRing")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
eval [Module Ann]
_ ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(App Ann
_
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.Ring) (Ident Text
"negate")))
(Var Ann
_ Qualified Ident
qi))
Expr Ann
e)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.ring) (Text -> Ident
Ident Text
"ringInt")
, Literal Ann
_ (NumericLiteral (Left Integer
a)) <- Expr Ann
e
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. a -> Either a b
Left (-Integer
a)))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.ring) (Text -> Ident
Ident Text
"ringNumber")
, Literal Ann
_ (NumericLiteral (Right Double
a)) <- Expr Ann
e
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Either Integer Double -> Literal a
NumericLiteral (forall a b. b -> Either a b
Right (-Double
a)))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.ring) (Text -> Ident
Ident Text
"unitRing")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
eval [Module Ann]
_ ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.HeytingAlgebra) (Ident Text
"ff")))
(Var Ann
_ Qualified Ident
qi))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraBoolean")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal (SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing) (forall a. Bool -> Literal a
BooleanLiteral Bool
False)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_ ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.HeytingAlgebra) (Ident Text
"tt")))
(Var Ann
_ Qualified Ident
qi))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraBoolean")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal (SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing) (forall a. Bool -> Literal a
BooleanLiteral Bool
True)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_mods ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(App Ann
_
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.HeytingAlgebra) (Ident Text
"not")))
(Var Ann
_ Qualified Ident
qi))
Expr Ann
e)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraBoolean")
, Literal Ann
_ (BooleanLiteral Bool
b) <- Expr Ann
e
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Bool -> Literal a
BooleanLiteral (Bool -> Bool
not Bool
b))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_mods ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(App Ann
_
(App Ann
_
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.HeytingAlgebra) (Ident Text
"implies")))
(Var Ann
_ Qualified Ident
qi))
Expr Ann
e1)
Expr Ann
e2)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraBoolean")
, Literal Ann
_ (BooleanLiteral Bool
b1) <- Expr Ann
e1
, Literal Ann
_ (BooleanLiteral Bool
b2) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Bool -> Literal a
BooleanLiteral (Bool -> Bool
not Bool
b1 Bool -> Bool -> Bool
&& Bool
b2))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_mods ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(App Ann
_
(App Ann
_
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.HeytingAlgebra) (Ident Text
"disj")))
(Var Ann
_ Qualified Ident
qi))
Expr Ann
e1)
Expr Ann
e2)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraBoolean")
, Literal Ann
_ (BooleanLiteral Bool
b1) <- Expr Ann
e1
, Literal Ann
_ (BooleanLiteral Bool
b2) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Bool -> Literal a
BooleanLiteral (Bool
b1 Bool -> Bool -> Bool
|| Bool
b2))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_mods ModuleName
_mn Stack
_st
(App (SourceSpan
ss, [Comment]
c, Maybe SourceType
_, Maybe Meta
_)
(App Ann
_
(App Ann
_
(Var Ann
_ (Qualified (ByModuleName ModuleName
C.HeytingAlgebra) (Ident Text
"conj")))
(Var Ann
_ Qualified Ident
qi))
Expr Ann
e1)
Expr Ann
e2)
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraBoolean")
, Literal Ann
_ (BooleanLiteral Bool
b1) <- Expr Ann
e1
, Literal Ann
_ (BooleanLiteral Bool
b2) <- Expr Ann
e2
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. Bool -> Literal a
BooleanLiteral (Bool
b1 Bool -> Bool -> Bool
&& Bool
b2))
| Qualified Ident
qi forall a. Eq a => a -> a -> Bool
== forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.heytingAlgebra) (Text -> Ident
Ident Text
"heytingAlgebraUnit")
= forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var
(SourceSpan
ss, [Comment]
c, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
(forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
C.unit) (Text -> Ident
Ident Text
"unit"))
| Bool
otherwise
= forall a. Maybe a
Nothing
eval [Module Ann]
_ ModuleName
_ Stack
_ Expr Ann
_ = forall a. Maybe a
Nothing
data LookupResult =
FoundExpr !(Expr Ann)
| Found
lookupQualifiedExpr :: [Module Ann]
-> ModuleName
-> Ident
-> Maybe LookupResult
lookupQualifiedExpr :: [Module Ann] -> ModuleName -> Ident -> Maybe LookupResult
lookupQualifiedExpr [Module Ann]
_ (ModuleName Text
mn) Ident
_
| Text
"Prim" : [Text]
_ <- Text -> Text -> [Text]
T.splitOn Text
"." Text
mn
= forall a. a -> Maybe a
Just LookupResult
Found
lookupQualifiedExpr [Module Ann]
_ (ModuleName Text
"Data.Generic") (Ident Text
"anyProxy") =
forall a. a -> Maybe a
Just LookupResult
Found
lookupQualifiedExpr [Module Ann]
mods ModuleName
mn Ident
i =
(Maybe (Module Ann)
mod forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr Ann -> LookupResult
FoundExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Ident
i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bind Ann -> [(Ident, Expr Ann)]
unBind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Module a -> [Bind a]
moduleDecls)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe (Module Ann)
mod forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const LookupResult
Found)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
== Ident
i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Module a -> [Ident]
moduleForeign)
where
mod :: Maybe (Module Ann)
mod = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Module Ann
m -> forall a. Module a -> ModuleName
moduleName Module Ann
m forall a. Eq a => a -> a -> Bool
== ModuleName
mn) [Module Ann]
mods
eqLit :: Literal a -> Literal b -> Bool
eqLit :: forall a b. Literal a -> Literal b -> Bool
eqLit (NumericLiteral (Left Integer
a)) (NumericLiteral (Left Integer
b)) = Integer
a forall a. Eq a => a -> a -> Bool
== Integer
b
eqLit (NumericLiteral (Right Double
a)) (NumericLiteral (Right Double
b)) = Double
a forall a. Eq a => a -> a -> Bool
== Double
b
eqLit (StringLiteral PSString
a) (StringLiteral PSString
b) = PSString
a forall a. Eq a => a -> a -> Bool
== PSString
b
eqLit (CharLiteral Char
a) (CharLiteral Char
b) = Char
a forall a. Eq a => a -> a -> Bool
== Char
b
eqLit (BooleanLiteral Bool
a) (BooleanLiteral Bool
b) = Bool
a forall a. Eq a => a -> a -> Bool
== Bool
b
eqLit Literal a
_ Literal b
_ = Bool
False