{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE PatternSynonyms #-}
module GHC.JS.Syntax
(
JStat(..)
, JExpr(..)
, JVal(..)
, JOp(..)
, JUOp(..)
, Ident(..)
, identFS
, JsLabel
, pattern New
, pattern Not
, pattern Negate
, pattern Add
, pattern Sub
, pattern Mul
, pattern Div
, pattern Mod
, pattern BOr
, pattern BAnd
, pattern BXor
, pattern BNot
, pattern LOr
, pattern LAnd
, pattern Int
, pattern String
, pattern PreInc
, pattern PostInc
, pattern PreDec
, pattern PostDec
, IdentSupply(..)
, newIdentSupply
, pseudoSaturate
, SaneDouble(..)
) where
import GHC.Prelude
import Control.DeepSeq
import Data.Function
import Data.Data
import Data.Word
import qualified Data.Semigroup as Semigroup
import GHC.Generics
import GHC.Data.FastString
import GHC.Utils.Monad.State.Strict
import GHC.Types.Unique
import GHC.Types.Unique.Map
newtype IdentSupply a
= IS {forall a. IdentSupply a -> State [Ident] a
runIdentSupply :: State [Ident] a}
deriving Typeable
instance NFData (IdentSupply a) where rnf :: IdentSupply a -> ()
rnf IS{} = ()
inIdentSupply :: (State [Ident] a -> State [Ident] b) -> IdentSupply a -> IdentSupply b
inIdentSupply :: forall a b.
(State [Ident] a -> State [Ident] b)
-> IdentSupply a -> IdentSupply b
inIdentSupply State [Ident] a -> State [Ident] b
f IdentSupply a
x = State [Ident] b -> IdentSupply b
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] b -> IdentSupply b)
-> State [Ident] b -> IdentSupply b
forall a b. (a -> b) -> a -> b
$ State [Ident] a -> State [Ident] b
f (IdentSupply a -> State [Ident] a
forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply a
x)
instance Functor IdentSupply where
fmap :: forall a b. (a -> b) -> IdentSupply a -> IdentSupply b
fmap a -> b
f IdentSupply a
x = (State [Ident] a -> State [Ident] b)
-> IdentSupply a -> IdentSupply b
forall a b.
(State [Ident] a -> State [Ident] b)
-> IdentSupply a -> IdentSupply b
inIdentSupply ((a -> b) -> State [Ident] a -> State [Ident] b
forall a b. (a -> b) -> State [Ident] a -> State [Ident] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) IdentSupply a
x
newIdentSupply :: Maybe FastString -> [Ident]
newIdentSupply :: Maybe FastString -> [Ident]
newIdentSupply Maybe FastString
Nothing = Maybe FastString -> [Ident]
newIdentSupply (FastString -> Maybe FastString
forall a. a -> Maybe a
Just FastString
"jmId")
newIdentSupply (Just FastString
pfx) = [ FastString -> Ident
TxtI ([FastString] -> FastString
forall a. Monoid a => [a] -> a
mconcat [FastString
pfx,FastString
"_",String -> FastString
mkFastString (Word64 -> String
forall a. Show a => a -> String
show Word64
x)])
| Word64
x <- [(Word64
0::Word64)..]
]
pseudoSaturate :: IdentSupply a -> a
pseudoSaturate :: forall a. IdentSupply a -> a
pseudoSaturate IdentSupply a
x = State [Ident] a -> [Ident] -> a
forall s a. State s a -> s -> a
evalState (IdentSupply a -> State [Ident] a
forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply a
x) ([Ident] -> a) -> [Ident] -> a
forall a b. (a -> b) -> a -> b
$ Maybe FastString -> [Ident]
newIdentSupply (FastString -> Maybe FastString
forall a. a -> Maybe a
Just FastString
"<<unsatId>>")
instance Eq a => Eq (IdentSupply a) where
== :: IdentSupply a -> IdentSupply a -> Bool
(==) = a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool)
-> (IdentSupply a -> a) -> IdentSupply a -> IdentSupply a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` IdentSupply a -> a
forall a. IdentSupply a -> a
pseudoSaturate
instance Ord a => Ord (IdentSupply a) where
compare :: IdentSupply a -> IdentSupply a -> Ordering
compare = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> a -> Ordering)
-> (IdentSupply a -> a)
-> IdentSupply a
-> IdentSupply a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` IdentSupply a -> a
forall a. IdentSupply a -> a
pseudoSaturate
instance Show a => Show (IdentSupply a) where
show :: IdentSupply a -> String
show IdentSupply a
x = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (IdentSupply a -> a
forall a. IdentSupply a -> a
pseudoSaturate IdentSupply a
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
data JStat
= DeclStat !Ident !(Maybe JExpr)
| ReturnStat JExpr
| IfStat JExpr JStat JStat
| WhileStat Bool JExpr JStat
| ForInStat Bool Ident JExpr JStat
| SwitchStat JExpr [(JExpr, JStat)] JStat
| TryStat JStat Ident JStat JStat
| BlockStat [JStat]
| ApplStat JExpr [JExpr]
| UOpStat JUOp JExpr
| AssignStat JExpr JExpr
| UnsatBlock (IdentSupply JStat)
| LabelStat JsLabel JStat
| BreakStat (Maybe JsLabel)
| ContinueStat (Maybe JsLabel)
deriving (JStat -> JStat -> Bool
(JStat -> JStat -> Bool) -> (JStat -> JStat -> Bool) -> Eq JStat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JStat -> JStat -> Bool
== :: JStat -> JStat -> Bool
$c/= :: JStat -> JStat -> Bool
/= :: JStat -> JStat -> Bool
Eq, Typeable, (forall x. JStat -> Rep JStat x)
-> (forall x. Rep JStat x -> JStat) -> Generic JStat
forall x. Rep JStat x -> JStat
forall x. JStat -> Rep JStat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JStat -> Rep JStat x
from :: forall x. JStat -> Rep JStat x
$cto :: forall x. Rep JStat x -> JStat
to :: forall x. Rep JStat x -> JStat
Generic)
type JsLabel = LexicalFastString
instance Semigroup JStat where
<> :: JStat -> JStat -> JStat
(<>) = JStat -> JStat -> JStat
appendJStat
instance Monoid JStat where
mempty :: JStat
mempty = [JStat] -> JStat
BlockStat []
appendJStat :: JStat -> JStat -> JStat
appendJStat :: JStat -> JStat -> JStat
appendJStat JStat
mx JStat
my = case (JStat
mx,JStat
my) of
(BlockStat [] , JStat
y ) -> JStat
y
(JStat
x , BlockStat []) -> JStat
x
(BlockStat [JStat]
xs , BlockStat [JStat]
ys) -> [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat]
xs [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat]
ys
(BlockStat [JStat]
xs , JStat
ys ) -> [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat]
xs [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat
ys]
(JStat
xs , BlockStat [JStat]
ys) -> [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ JStat
xs JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
ys
(JStat
xs , JStat
ys ) -> [JStat] -> JStat
BlockStat [JStat
xs,JStat
ys]
data JExpr
= ValExpr JVal
| SelExpr JExpr Ident
| IdxExpr JExpr JExpr
| InfixExpr JOp JExpr JExpr
| UOpExpr JUOp JExpr
| IfExpr JExpr JExpr JExpr
| ApplExpr JExpr [JExpr]
| UnsatExpr (IdentSupply JExpr)
deriving (JExpr -> JExpr -> Bool
(JExpr -> JExpr -> Bool) -> (JExpr -> JExpr -> Bool) -> Eq JExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JExpr -> JExpr -> Bool
== :: JExpr -> JExpr -> Bool
$c/= :: JExpr -> JExpr -> Bool
/= :: JExpr -> JExpr -> Bool
Eq, Typeable, (forall x. JExpr -> Rep JExpr x)
-> (forall x. Rep JExpr x -> JExpr) -> Generic JExpr
forall x. Rep JExpr x -> JExpr
forall x. JExpr -> Rep JExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JExpr -> Rep JExpr x
from :: forall x. JExpr -> Rep JExpr x
$cto :: forall x. Rep JExpr x -> JExpr
to :: forall x. Rep JExpr x -> JExpr
Generic)
pattern New :: JExpr -> JExpr
pattern $mNew :: forall {r}. JExpr -> (JExpr -> r) -> ((# #) -> r) -> r
$bNew :: JExpr -> JExpr
New x = UOpExpr NewOp x
pattern PreInc :: JExpr -> JExpr
pattern $mPreInc :: forall {r}. JExpr -> (JExpr -> r) -> ((# #) -> r) -> r
$bPreInc :: JExpr -> JExpr
PreInc x = UOpExpr PreIncOp x
pattern PostInc :: JExpr -> JExpr
pattern $mPostInc :: forall {r}. JExpr -> (JExpr -> r) -> ((# #) -> r) -> r
$bPostInc :: JExpr -> JExpr
PostInc x = UOpExpr PostIncOp x
pattern PreDec :: JExpr -> JExpr
pattern $mPreDec :: forall {r}. JExpr -> (JExpr -> r) -> ((# #) -> r) -> r
$bPreDec :: JExpr -> JExpr
PreDec x = UOpExpr PreDecOp x
pattern PostDec :: JExpr -> JExpr
pattern $mPostDec :: forall {r}. JExpr -> (JExpr -> r) -> ((# #) -> r) -> r
$bPostDec :: JExpr -> JExpr
PostDec x = UOpExpr PostDecOp x
pattern Not :: JExpr -> JExpr
pattern $mNot :: forall {r}. JExpr -> (JExpr -> r) -> ((# #) -> r) -> r
$bNot :: JExpr -> JExpr
Not x = UOpExpr NotOp x
pattern Negate :: JExpr -> JExpr
pattern $mNegate :: forall {r}. JExpr -> (JExpr -> r) -> ((# #) -> r) -> r
$bNegate :: JExpr -> JExpr
Negate x = UOpExpr NegOp x
pattern Add :: JExpr -> JExpr -> JExpr
pattern $mAdd :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bAdd :: JExpr -> JExpr -> JExpr
Add x y = InfixExpr AddOp x y
pattern Sub :: JExpr -> JExpr -> JExpr
pattern $mSub :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bSub :: JExpr -> JExpr -> JExpr
Sub x y = InfixExpr SubOp x y
pattern Mul :: JExpr -> JExpr -> JExpr
pattern $mMul :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bMul :: JExpr -> JExpr -> JExpr
Mul x y = InfixExpr MulOp x y
pattern Div :: JExpr -> JExpr -> JExpr
pattern $mDiv :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bDiv :: JExpr -> JExpr -> JExpr
Div x y = InfixExpr DivOp x y
pattern Mod :: JExpr -> JExpr -> JExpr
pattern $mMod :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bMod :: JExpr -> JExpr -> JExpr
Mod x y = InfixExpr ModOp x y
pattern BOr :: JExpr -> JExpr -> JExpr
pattern $mBOr :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bBOr :: JExpr -> JExpr -> JExpr
BOr x y = InfixExpr BOrOp x y
pattern BAnd :: JExpr -> JExpr -> JExpr
pattern $mBAnd :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bBAnd :: JExpr -> JExpr -> JExpr
BAnd x y = InfixExpr BAndOp x y
pattern BXor :: JExpr -> JExpr -> JExpr
pattern $mBXor :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bBXor :: JExpr -> JExpr -> JExpr
BXor x y = InfixExpr BXorOp x y
pattern BNot :: JExpr -> JExpr
pattern $mBNot :: forall {r}. JExpr -> (JExpr -> r) -> ((# #) -> r) -> r
$bBNot :: JExpr -> JExpr
BNot x = UOpExpr BNotOp x
pattern LOr :: JExpr -> JExpr -> JExpr
pattern $mLOr :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bLOr :: JExpr -> JExpr -> JExpr
LOr x y = InfixExpr LOrOp x y
pattern LAnd :: JExpr -> JExpr -> JExpr
pattern $mLAnd :: forall {r}. JExpr -> (JExpr -> JExpr -> r) -> ((# #) -> r) -> r
$bLAnd :: JExpr -> JExpr -> JExpr
LAnd x y = InfixExpr LAndOp x y
pattern Int :: Integer -> JExpr
pattern $mInt :: forall {r}. JExpr -> (Integer -> r) -> ((# #) -> r) -> r
$bInt :: Integer -> JExpr
Int x = ValExpr (JInt x)
pattern String :: FastString -> JExpr
pattern $mString :: forall {r}. JExpr -> (FastString -> r) -> ((# #) -> r) -> r
$bString :: FastString -> JExpr
String x = ValExpr (JStr x)
data JVal
= JVar Ident
| JList [JExpr]
| JDouble SaneDouble
| JInt Integer
| JStr FastString
| JRegEx FastString
| JHash (UniqMap FastString JExpr)
| JFunc [Ident] JStat
| UnsatVal (IdentSupply JVal)
deriving (JVal -> JVal -> Bool
(JVal -> JVal -> Bool) -> (JVal -> JVal -> Bool) -> Eq JVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JVal -> JVal -> Bool
== :: JVal -> JVal -> Bool
$c/= :: JVal -> JVal -> Bool
/= :: JVal -> JVal -> Bool
Eq, Typeable, (forall x. JVal -> Rep JVal x)
-> (forall x. Rep JVal x -> JVal) -> Generic JVal
forall x. Rep JVal x -> JVal
forall x. JVal -> Rep JVal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JVal -> Rep JVal x
from :: forall x. JVal -> Rep JVal x
$cto :: forall x. Rep JVal x -> JVal
to :: forall x. Rep JVal x -> JVal
Generic)
data JOp
= EqOp
| StrictEqOp
| NeqOp
| StrictNeqOp
| GtOp
| GeOp
| LtOp
| LeOp
| AddOp
| SubOp
| MulOp
| DivOp
| ModOp
| LeftShiftOp
| RightShiftOp
| ZRightShiftOp
| BAndOp
| BOrOp
| BXorOp
| LAndOp
| LOrOp
| InstanceofOp
| InOp
deriving (Int -> JOp -> ShowS
[JOp] -> ShowS
JOp -> String
(Int -> JOp -> ShowS)
-> (JOp -> String) -> ([JOp] -> ShowS) -> Show JOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JOp -> ShowS
showsPrec :: Int -> JOp -> ShowS
$cshow :: JOp -> String
show :: JOp -> String
$cshowList :: [JOp] -> ShowS
showList :: [JOp] -> ShowS
Show, JOp -> JOp -> Bool
(JOp -> JOp -> Bool) -> (JOp -> JOp -> Bool) -> Eq JOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JOp -> JOp -> Bool
== :: JOp -> JOp -> Bool
$c/= :: JOp -> JOp -> Bool
/= :: JOp -> JOp -> Bool
Eq, Eq JOp
Eq JOp =>
(JOp -> JOp -> Ordering)
-> (JOp -> JOp -> Bool)
-> (JOp -> JOp -> Bool)
-> (JOp -> JOp -> Bool)
-> (JOp -> JOp -> Bool)
-> (JOp -> JOp -> JOp)
-> (JOp -> JOp -> JOp)
-> Ord JOp
JOp -> JOp -> Bool
JOp -> JOp -> Ordering
JOp -> JOp -> JOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JOp -> JOp -> Ordering
compare :: JOp -> JOp -> Ordering
$c< :: JOp -> JOp -> Bool
< :: JOp -> JOp -> Bool
$c<= :: JOp -> JOp -> Bool
<= :: JOp -> JOp -> Bool
$c> :: JOp -> JOp -> Bool
> :: JOp -> JOp -> Bool
$c>= :: JOp -> JOp -> Bool
>= :: JOp -> JOp -> Bool
$cmax :: JOp -> JOp -> JOp
max :: JOp -> JOp -> JOp
$cmin :: JOp -> JOp -> JOp
min :: JOp -> JOp -> JOp
Ord, Int -> JOp
JOp -> Int
JOp -> [JOp]
JOp -> JOp
JOp -> JOp -> [JOp]
JOp -> JOp -> JOp -> [JOp]
(JOp -> JOp)
-> (JOp -> JOp)
-> (Int -> JOp)
-> (JOp -> Int)
-> (JOp -> [JOp])
-> (JOp -> JOp -> [JOp])
-> (JOp -> JOp -> [JOp])
-> (JOp -> JOp -> JOp -> [JOp])
-> Enum JOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: JOp -> JOp
succ :: JOp -> JOp
$cpred :: JOp -> JOp
pred :: JOp -> JOp
$ctoEnum :: Int -> JOp
toEnum :: Int -> JOp
$cfromEnum :: JOp -> Int
fromEnum :: JOp -> Int
$cenumFrom :: JOp -> [JOp]
enumFrom :: JOp -> [JOp]
$cenumFromThen :: JOp -> JOp -> [JOp]
enumFromThen :: JOp -> JOp -> [JOp]
$cenumFromTo :: JOp -> JOp -> [JOp]
enumFromTo :: JOp -> JOp -> [JOp]
$cenumFromThenTo :: JOp -> JOp -> JOp -> [JOp]
enumFromThenTo :: JOp -> JOp -> JOp -> [JOp]
Enum, Typeable JOp
Typeable JOp =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JOp -> c JOp)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JOp)
-> (JOp -> Constr)
-> (JOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JOp))
-> ((forall b. Data b => b -> b) -> JOp -> JOp)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JOp -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> JOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JOp -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp)
-> Data JOp
JOp -> Constr
JOp -> DataType
(forall b. Data b => b -> b) -> JOp -> JOp
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JOp -> u
forall u. (forall d. Data d => d -> u) -> JOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JOp -> c JOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JOp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JOp -> c JOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JOp -> c JOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JOp
$ctoConstr :: JOp -> Constr
toConstr :: JOp -> Constr
$cdataTypeOf :: JOp -> DataType
dataTypeOf :: JOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JOp)
$cgmapT :: (forall b. Data b => b -> b) -> JOp -> JOp
gmapT :: (forall b. Data b => b -> b) -> JOp -> JOp
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JOp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JOp -> m JOp
Data, Typeable, (forall x. JOp -> Rep JOp x)
-> (forall x. Rep JOp x -> JOp) -> Generic JOp
forall x. Rep JOp x -> JOp
forall x. JOp -> Rep JOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JOp -> Rep JOp x
from :: forall x. JOp -> Rep JOp x
$cto :: forall x. Rep JOp x -> JOp
to :: forall x. Rep JOp x -> JOp
Generic)
instance NFData JOp
data JUOp
= NotOp
| BNotOp
| NegOp
| PlusOp
| NewOp
| TypeofOp
| DeleteOp
| YieldOp
| VoidOp
| PreIncOp
| PostIncOp
| PreDecOp
| PostDecOp
deriving (Int -> JUOp -> ShowS
[JUOp] -> ShowS
JUOp -> String
(Int -> JUOp -> ShowS)
-> (JUOp -> String) -> ([JUOp] -> ShowS) -> Show JUOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JUOp -> ShowS
showsPrec :: Int -> JUOp -> ShowS
$cshow :: JUOp -> String
show :: JUOp -> String
$cshowList :: [JUOp] -> ShowS
showList :: [JUOp] -> ShowS
Show, JUOp -> JUOp -> Bool
(JUOp -> JUOp -> Bool) -> (JUOp -> JUOp -> Bool) -> Eq JUOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JUOp -> JUOp -> Bool
== :: JUOp -> JUOp -> Bool
$c/= :: JUOp -> JUOp -> Bool
/= :: JUOp -> JUOp -> Bool
Eq, Eq JUOp
Eq JUOp =>
(JUOp -> JUOp -> Ordering)
-> (JUOp -> JUOp -> Bool)
-> (JUOp -> JUOp -> Bool)
-> (JUOp -> JUOp -> Bool)
-> (JUOp -> JUOp -> Bool)
-> (JUOp -> JUOp -> JUOp)
-> (JUOp -> JUOp -> JUOp)
-> Ord JUOp
JUOp -> JUOp -> Bool
JUOp -> JUOp -> Ordering
JUOp -> JUOp -> JUOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JUOp -> JUOp -> Ordering
compare :: JUOp -> JUOp -> Ordering
$c< :: JUOp -> JUOp -> Bool
< :: JUOp -> JUOp -> Bool
$c<= :: JUOp -> JUOp -> Bool
<= :: JUOp -> JUOp -> Bool
$c> :: JUOp -> JUOp -> Bool
> :: JUOp -> JUOp -> Bool
$c>= :: JUOp -> JUOp -> Bool
>= :: JUOp -> JUOp -> Bool
$cmax :: JUOp -> JUOp -> JUOp
max :: JUOp -> JUOp -> JUOp
$cmin :: JUOp -> JUOp -> JUOp
min :: JUOp -> JUOp -> JUOp
Ord, Int -> JUOp
JUOp -> Int
JUOp -> [JUOp]
JUOp -> JUOp
JUOp -> JUOp -> [JUOp]
JUOp -> JUOp -> JUOp -> [JUOp]
(JUOp -> JUOp)
-> (JUOp -> JUOp)
-> (Int -> JUOp)
-> (JUOp -> Int)
-> (JUOp -> [JUOp])
-> (JUOp -> JUOp -> [JUOp])
-> (JUOp -> JUOp -> [JUOp])
-> (JUOp -> JUOp -> JUOp -> [JUOp])
-> Enum JUOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: JUOp -> JUOp
succ :: JUOp -> JUOp
$cpred :: JUOp -> JUOp
pred :: JUOp -> JUOp
$ctoEnum :: Int -> JUOp
toEnum :: Int -> JUOp
$cfromEnum :: JUOp -> Int
fromEnum :: JUOp -> Int
$cenumFrom :: JUOp -> [JUOp]
enumFrom :: JUOp -> [JUOp]
$cenumFromThen :: JUOp -> JUOp -> [JUOp]
enumFromThen :: JUOp -> JUOp -> [JUOp]
$cenumFromTo :: JUOp -> JUOp -> [JUOp]
enumFromTo :: JUOp -> JUOp -> [JUOp]
$cenumFromThenTo :: JUOp -> JUOp -> JUOp -> [JUOp]
enumFromThenTo :: JUOp -> JUOp -> JUOp -> [JUOp]
Enum, Typeable JUOp
Typeable JUOp =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JUOp -> c JUOp)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JUOp)
-> (JUOp -> Constr)
-> (JUOp -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JUOp))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JUOp))
-> ((forall b. Data b => b -> b) -> JUOp -> JUOp)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JUOp -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JUOp -> r)
-> (forall u. (forall d. Data d => d -> u) -> JUOp -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JUOp -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp)
-> Data JUOp
JUOp -> Constr
JUOp -> DataType
(forall b. Data b => b -> b) -> JUOp -> JUOp
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JUOp -> u
forall u. (forall d. Data d => d -> u) -> JUOp -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JUOp -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JUOp -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JUOp
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JUOp -> c JUOp
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JUOp)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JUOp)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JUOp -> c JUOp
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JUOp -> c JUOp
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JUOp
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JUOp
$ctoConstr :: JUOp -> Constr
toConstr :: JUOp -> Constr
$cdataTypeOf :: JUOp -> DataType
dataTypeOf :: JUOp -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JUOp)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JUOp)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JUOp)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JUOp)
$cgmapT :: (forall b. Data b => b -> b) -> JUOp -> JUOp
gmapT :: (forall b. Data b => b -> b) -> JUOp -> JUOp
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JUOp -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JUOp -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JUOp -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JUOp -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JUOp -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> JUOp -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JUOp -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JUOp -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JUOp -> m JUOp
Data, Typeable, (forall x. JUOp -> Rep JUOp x)
-> (forall x. Rep JUOp x -> JUOp) -> Generic JUOp
forall x. Rep JUOp x -> JUOp
forall x. JUOp -> Rep JUOp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JUOp -> Rep JUOp x
from :: forall x. JUOp -> Rep JUOp x
$cto :: forall x. Rep JUOp x -> JUOp
to :: forall x. Rep JUOp x -> JUOp
Generic)
instance NFData JUOp
newtype SaneDouble = SaneDouble
{ SaneDouble -> Double
unSaneDouble :: Double
}
deriving (Typeable SaneDouble
Typeable SaneDouble =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SaneDouble -> c SaneDouble)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SaneDouble)
-> (SaneDouble -> Constr)
-> (SaneDouble -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SaneDouble))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SaneDouble))
-> ((forall b. Data b => b -> b) -> SaneDouble -> SaneDouble)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r)
-> (forall u. (forall d. Data d => d -> u) -> SaneDouble -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> SaneDouble -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble)
-> Data SaneDouble
SaneDouble -> Constr
SaneDouble -> DataType
(forall b. Data b => b -> b) -> SaneDouble -> SaneDouble
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SaneDouble -> u
forall u. (forall d. Data d => d -> u) -> SaneDouble -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SaneDouble
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SaneDouble -> c SaneDouble
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SaneDouble)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SaneDouble)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SaneDouble -> c SaneDouble
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SaneDouble -> c SaneDouble
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SaneDouble
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SaneDouble
$ctoConstr :: SaneDouble -> Constr
toConstr :: SaneDouble -> Constr
$cdataTypeOf :: SaneDouble -> DataType
dataTypeOf :: SaneDouble -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SaneDouble)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SaneDouble)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SaneDouble)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SaneDouble)
$cgmapT :: (forall b. Data b => b -> b) -> SaneDouble -> SaneDouble
gmapT :: (forall b. Data b => b -> b) -> SaneDouble -> SaneDouble
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SaneDouble -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> SaneDouble -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SaneDouble -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SaneDouble -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
Data, Typeable, Num SaneDouble
Num SaneDouble =>
(SaneDouble -> SaneDouble -> SaneDouble)
-> (SaneDouble -> SaneDouble)
-> (Rational -> SaneDouble)
-> Fractional SaneDouble
Rational -> SaneDouble
SaneDouble -> SaneDouble
SaneDouble -> SaneDouble -> SaneDouble
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: SaneDouble -> SaneDouble -> SaneDouble
/ :: SaneDouble -> SaneDouble -> SaneDouble
$crecip :: SaneDouble -> SaneDouble
recip :: SaneDouble -> SaneDouble
$cfromRational :: Rational -> SaneDouble
fromRational :: Rational -> SaneDouble
Fractional, Integer -> SaneDouble
SaneDouble -> SaneDouble
SaneDouble -> SaneDouble -> SaneDouble
(SaneDouble -> SaneDouble -> SaneDouble)
-> (SaneDouble -> SaneDouble -> SaneDouble)
-> (SaneDouble -> SaneDouble -> SaneDouble)
-> (SaneDouble -> SaneDouble)
-> (SaneDouble -> SaneDouble)
-> (SaneDouble -> SaneDouble)
-> (Integer -> SaneDouble)
-> Num SaneDouble
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SaneDouble -> SaneDouble -> SaneDouble
+ :: SaneDouble -> SaneDouble -> SaneDouble
$c- :: SaneDouble -> SaneDouble -> SaneDouble
- :: SaneDouble -> SaneDouble -> SaneDouble
$c* :: SaneDouble -> SaneDouble -> SaneDouble
* :: SaneDouble -> SaneDouble -> SaneDouble
$cnegate :: SaneDouble -> SaneDouble
negate :: SaneDouble -> SaneDouble
$cabs :: SaneDouble -> SaneDouble
abs :: SaneDouble -> SaneDouble
$csignum :: SaneDouble -> SaneDouble
signum :: SaneDouble -> SaneDouble
$cfromInteger :: Integer -> SaneDouble
fromInteger :: Integer -> SaneDouble
Num, (forall x. SaneDouble -> Rep SaneDouble x)
-> (forall x. Rep SaneDouble x -> SaneDouble) -> Generic SaneDouble
forall x. Rep SaneDouble x -> SaneDouble
forall x. SaneDouble -> Rep SaneDouble x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SaneDouble -> Rep SaneDouble x
from :: forall x. SaneDouble -> Rep SaneDouble x
$cto :: forall x. Rep SaneDouble x -> SaneDouble
to :: forall x. Rep SaneDouble x -> SaneDouble
Generic, SaneDouble -> ()
(SaneDouble -> ()) -> NFData SaneDouble
forall a. (a -> ()) -> NFData a
$crnf :: SaneDouble -> ()
rnf :: SaneDouble -> ()
NFData)
instance Eq SaneDouble where
(SaneDouble Double
x) == :: SaneDouble -> SaneDouble -> Bool
== (SaneDouble Double
y) = Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y Bool -> Bool -> Bool
|| (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
&& Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
y)
instance Ord SaneDouble where
compare :: SaneDouble -> SaneDouble -> Ordering
compare (SaneDouble Double
x) (SaneDouble Double
y) = Maybe Double -> Maybe Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Double -> Maybe Double
forall {a}. RealFloat a => a -> Maybe a
fromNaN Double
x) (Double -> Maybe Double
forall {a}. RealFloat a => a -> Maybe a
fromNaN Double
y)
where fromNaN :: a -> Maybe a
fromNaN a
z | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
z = Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
z
instance Show SaneDouble where
show :: SaneDouble -> String
show (SaneDouble Double
x) = Double -> String
forall a. Show a => a -> String
show Double
x
newtype Ident = TxtI { Ident -> FastString
itxt :: FastString }
deriving stock (Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
(Int -> Ident -> ShowS)
-> (Ident -> String) -> ([Ident] -> ShowS) -> Show Ident
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ident -> ShowS
showsPrec :: Int -> Ident -> ShowS
$cshow :: Ident -> String
show :: Ident -> String
$cshowList :: [Ident] -> ShowS
showList :: [Ident] -> ShowS
Show, Ident -> Ident -> Bool
(Ident -> Ident -> Bool) -> (Ident -> Ident -> Bool) -> Eq Ident
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ident -> Ident -> Bool
== :: Ident -> Ident -> Bool
$c/= :: Ident -> Ident -> Bool
/= :: Ident -> Ident -> Bool
Eq)
deriving newtype (Ident -> Unique
(Ident -> Unique) -> Uniquable Ident
forall a. (a -> Unique) -> Uniquable a
$cgetUnique :: Ident -> Unique
getUnique :: Ident -> Unique
Uniquable)
identFS :: Ident -> FastString
identFS :: Ident -> FastString
identFS = \case
TxtI FastString
fs -> FastString
fs