{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances, OverloadedStrings, TypeFamilies, RankNTypes, DeriveDataTypeable, StandaloneDeriving, FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables, GADTs
, GeneralizedNewtypeDeriving, LambdaCase #-}
module Language.Javascript.JMacro.Base (
JStat(..), JExpr(..), JVal(..), Ident(..), IdentSupply(..), JsLabel,
JMacro(..), JMGadt(..), Compos(..),
composOp, composOpM, composOpM_, composOpFold,
withHygiene, scopify,
renderJs, renderPrefixJs, JsToDoc(..),
ToJExpr(..),
jsv,
jLam, jVar, jVarTy, jFor, jForIn, jForEachIn, jTryCatchFinally,
expr2stat, ToStat(..), nullStat,
jhEmpty, jhSingle, jhAdd, jhFromList,
jsSaturate, jtFromList, SaneDouble(..)
) where
import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)
import Control.Applicative hiding (empty)
import Control.Arrow ((***))
import Control.Monad.State.Strict
import Control.Monad.Identity
import Data.Function
import Data.Char (toLower,isControl)
import qualified Data.Map as M
import qualified Data.Text.Lazy as T
import qualified Data.Text as TS
import Data.Generics
import Data.Monoid(Monoid, mappend, mempty)
import Data.Semigroup(Semigroup(..))
import Numeric(showHex)
import Safe
import Data.Aeson
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as HM
import Text.PrettyPrint.Leijen.Text hiding ((<$>))
import qualified Text.PrettyPrint.Leijen.Text as PP
import Language.Javascript.JMacro.Types
infixl 5 $$, $+$
($+$), ($$), ($$$) :: Doc -> Doc -> Doc
x :: Doc
x $+$ :: Doc -> Doc -> Doc
$+$ y :: Doc
y = Doc
x Doc -> Doc -> Doc
PP.<$> Doc
y
x :: Doc
x $$ :: Doc -> Doc -> Doc
$$ y :: Doc
y = Doc -> Doc
align (Doc
x Doc -> Doc -> Doc
$+$ Doc
y)
x :: Doc
x $$$ :: Doc -> Doc -> Doc
$$$ y :: Doc
y = Doc -> Doc
align (Int -> Doc -> Doc
nest 2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
x Doc -> Doc -> Doc
$+$ Doc
y)
newtype IdentSupply a = IS {IdentSupply a -> State [Ident] a
runIdentSupply :: State [Ident] a} deriving Typeable
inIdentSupply :: (State [Ident] a -> State [Ident] b) -> IdentSupply a -> IdentSupply b
inIdentSupply :: (State [Ident] a -> State [Ident] b)
-> IdentSupply a -> IdentSupply b
inIdentSupply f :: State [Ident] a -> State [Ident] b
f x :: 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 Data a => Data (IdentSupply a) where
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IdentSupply a)
gunfold _ _ _ = [Char] -> c (IdentSupply a)
forall a. HasCallStack => [Char] -> a
error "gunfold IdentSupply"
toConstr :: IdentSupply a -> Constr
toConstr _ = [Char] -> Constr
forall a. HasCallStack => [Char] -> a
error "toConstr IdentSupply"
dataTypeOf :: IdentSupply a -> DataType
dataTypeOf _ = [Char] -> DataType
mkNoRepType "IdentSupply"
instance Functor IdentSupply where
fmap :: (a -> b) -> IdentSupply a -> IdentSupply b
fmap f :: a -> b
f x :: 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) IdentSupply a
x
takeOne :: State [Ident] Ident
takeOne :: State [Ident] Ident
takeOne = do
StateT [Ident] Identity [Ident]
forall s (m :: * -> *). MonadState s m => m s
get StateT [Ident] Identity [Ident]
-> ([Ident] -> State [Ident] Ident) -> State [Ident] Ident
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(x :: Ident
x:xs :: [Ident]
xs) -> do
[Ident] -> StateT [Ident] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
xs
Ident -> State [Ident] Ident
forall (m :: * -> *) a. Monad m => a -> m a
return Ident
x
_ -> [Char] -> State [Ident] Ident
forall a. HasCallStack => [Char] -> a
error "not enough elements"
newIdentSupply :: Maybe String -> [Ident]
newIdentSupply :: Maybe [Char] -> [Ident]
newIdentSupply Nothing = Maybe [Char] -> [Ident]
newIdentSupply ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just "jmId")
newIdentSupply (Just pfx' :: [Char]
pfx') = [[Char] -> Ident
StrI ([Char]
pfx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
x) | Integer
x <- [(0::Integer)..]]
where pfx :: [Char]
pfx = [Char]
pfx'[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++['_']
sat_ :: IdentSupply a -> a
sat_ :: IdentSupply a -> a
sat_ x :: 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 [Char] -> [Ident]
newIdentSupply ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just "<<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
sat_
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
sat_
instance Show a => Show (IdentSupply a) where
show :: IdentSupply a -> [Char]
show x :: IdentSupply a
x = "(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show (IdentSupply a -> a
forall a. IdentSupply a -> a
sat_ IdentSupply a
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ")"
data JStat = DeclStat Ident (Maybe JLocalType)
| 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]
| PPostStat Bool String JExpr
| AssignStat JExpr JExpr
| UnsatBlock (IdentSupply JStat)
| AntiStat String
| ForeignStat Ident JLocalType
| 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
/= :: JStat -> JStat -> Bool
$c/= :: JStat -> JStat -> Bool
== :: JStat -> JStat -> Bool
$c== :: JStat -> JStat -> Bool
Eq, Eq JStat
Eq JStat =>
(JStat -> JStat -> Ordering)
-> (JStat -> JStat -> Bool)
-> (JStat -> JStat -> Bool)
-> (JStat -> JStat -> Bool)
-> (JStat -> JStat -> Bool)
-> (JStat -> JStat -> JStat)
-> (JStat -> JStat -> JStat)
-> Ord JStat
JStat -> JStat -> Bool
JStat -> JStat -> Ordering
JStat -> JStat -> JStat
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
min :: JStat -> JStat -> JStat
$cmin :: JStat -> JStat -> JStat
max :: JStat -> JStat -> JStat
$cmax :: JStat -> JStat -> JStat
>= :: JStat -> JStat -> Bool
$c>= :: JStat -> JStat -> Bool
> :: JStat -> JStat -> Bool
$c> :: JStat -> JStat -> Bool
<= :: JStat -> JStat -> Bool
$c<= :: JStat -> JStat -> Bool
< :: JStat -> JStat -> Bool
$c< :: JStat -> JStat -> Bool
compare :: JStat -> JStat -> Ordering
$ccompare :: JStat -> JStat -> Ordering
$cp1Ord :: Eq JStat
Ord, Int -> JStat -> [Char] -> [Char]
[JStat] -> [Char] -> [Char]
JStat -> [Char]
(Int -> JStat -> [Char] -> [Char])
-> (JStat -> [Char]) -> ([JStat] -> [Char] -> [Char]) -> Show JStat
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [JStat] -> [Char] -> [Char]
$cshowList :: [JStat] -> [Char] -> [Char]
show :: JStat -> [Char]
$cshow :: JStat -> [Char]
showsPrec :: Int -> JStat -> [Char] -> [Char]
$cshowsPrec :: Int -> JStat -> [Char] -> [Char]
Show, Typeable JStat
DataType
Constr
Typeable JStat =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JStat -> c JStat)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JStat)
-> (JStat -> Constr)
-> (JStat -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JStat))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JStat))
-> ((forall b. Data b => b -> b) -> JStat -> JStat)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r)
-> (forall u. (forall d. Data d => d -> u) -> JStat -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JStat -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JStat -> m JStat)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JStat -> m JStat)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JStat -> m JStat)
-> Data JStat
JStat -> DataType
JStat -> Constr
(forall b. Data b => b -> b) -> JStat -> JStat
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JStat -> c JStat
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JStat
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) -> JStat -> u
forall u. (forall d. Data d => d -> u) -> JStat -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JStat -> m JStat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JStat -> m JStat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JStat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JStat -> c JStat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JStat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JStat)
$cContinueStat :: Constr
$cBreakStat :: Constr
$cLabelStat :: Constr
$cForeignStat :: Constr
$cAntiStat :: Constr
$cUnsatBlock :: Constr
$cAssignStat :: Constr
$cPPostStat :: Constr
$cApplStat :: Constr
$cBlockStat :: Constr
$cTryStat :: Constr
$cSwitchStat :: Constr
$cForInStat :: Constr
$cWhileStat :: Constr
$cIfStat :: Constr
$cReturnStat :: Constr
$cDeclStat :: Constr
$tJStat :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JStat -> m JStat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JStat -> m JStat
gmapMp :: (forall d. Data d => d -> m d) -> JStat -> m JStat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JStat -> m JStat
gmapM :: (forall d. Data d => d -> m d) -> JStat -> m JStat
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JStat -> m JStat
gmapQi :: Int -> (forall d. Data d => d -> u) -> JStat -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JStat -> u
gmapQ :: (forall d. Data d => d -> u) -> JStat -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JStat -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JStat -> r
gmapT :: (forall b. Data b => b -> b) -> JStat -> JStat
$cgmapT :: (forall b. Data b => b -> b) -> JStat -> JStat
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JStat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JStat)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JStat)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JStat)
dataTypeOf :: JStat -> DataType
$cdataTypeOf :: JStat -> DataType
toConstr :: JStat -> Constr
$ctoConstr :: JStat -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JStat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JStat
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JStat -> c JStat
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JStat -> c JStat
$cp1Data :: Typeable JStat
Data, Typeable)
type JsLabel = String
instance Semigroup JStat where
<> :: JStat -> JStat -> JStat
(<>) (BlockStat xs :: [JStat]
xs) (BlockStat ys :: [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 xs :: [JStat]
xs) ys :: 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]
(<>) xs :: JStat
xs (BlockStat ys :: [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
(<>) xs :: JStat
xs ys :: JStat
ys = [JStat] -> JStat
BlockStat [JStat
xs,JStat
ys]
instance Monoid JStat where
mempty :: JStat
mempty = [JStat] -> JStat
BlockStat []
mappend :: JStat -> JStat -> JStat
mappend x :: JStat
x y :: JStat
y = JStat
x JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JStat
y
data JExpr = ValExpr JVal
| SelExpr JExpr Ident
| IdxExpr JExpr JExpr
| InfixExpr String JExpr JExpr
| PPostExpr Bool String JExpr
| IfExpr JExpr JExpr JExpr
| NewExpr JExpr
| ApplExpr JExpr [JExpr]
| UnsatExpr (IdentSupply JExpr)
| AntiExpr String
| TypeExpr Bool JExpr JLocalType
deriving (JExpr -> JExpr -> Bool
(JExpr -> JExpr -> Bool) -> (JExpr -> JExpr -> Bool) -> Eq JExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JExpr -> JExpr -> Bool
$c/= :: JExpr -> JExpr -> Bool
== :: JExpr -> JExpr -> Bool
$c== :: JExpr -> JExpr -> Bool
Eq, Eq JExpr
Eq JExpr =>
(JExpr -> JExpr -> Ordering)
-> (JExpr -> JExpr -> Bool)
-> (JExpr -> JExpr -> Bool)
-> (JExpr -> JExpr -> Bool)
-> (JExpr -> JExpr -> Bool)
-> (JExpr -> JExpr -> JExpr)
-> (JExpr -> JExpr -> JExpr)
-> Ord JExpr
JExpr -> JExpr -> Bool
JExpr -> JExpr -> Ordering
JExpr -> JExpr -> JExpr
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
min :: JExpr -> JExpr -> JExpr
$cmin :: JExpr -> JExpr -> JExpr
max :: JExpr -> JExpr -> JExpr
$cmax :: JExpr -> JExpr -> JExpr
>= :: JExpr -> JExpr -> Bool
$c>= :: JExpr -> JExpr -> Bool
> :: JExpr -> JExpr -> Bool
$c> :: JExpr -> JExpr -> Bool
<= :: JExpr -> JExpr -> Bool
$c<= :: JExpr -> JExpr -> Bool
< :: JExpr -> JExpr -> Bool
$c< :: JExpr -> JExpr -> Bool
compare :: JExpr -> JExpr -> Ordering
$ccompare :: JExpr -> JExpr -> Ordering
$cp1Ord :: Eq JExpr
Ord, Int -> JExpr -> [Char] -> [Char]
[JExpr] -> [Char] -> [Char]
JExpr -> [Char]
(Int -> JExpr -> [Char] -> [Char])
-> (JExpr -> [Char]) -> ([JExpr] -> [Char] -> [Char]) -> Show JExpr
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [JExpr] -> [Char] -> [Char]
$cshowList :: [JExpr] -> [Char] -> [Char]
show :: JExpr -> [Char]
$cshow :: JExpr -> [Char]
showsPrec :: Int -> JExpr -> [Char] -> [Char]
$cshowsPrec :: Int -> JExpr -> [Char] -> [Char]
Show, Typeable JExpr
DataType
Constr
Typeable JExpr =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JExpr -> c JExpr)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JExpr)
-> (JExpr -> Constr)
-> (JExpr -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JExpr))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JExpr))
-> ((forall b. Data b => b -> b) -> JExpr -> JExpr)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r)
-> (forall u. (forall d. Data d => d -> u) -> JExpr -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JExpr -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JExpr -> m JExpr)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JExpr -> m JExpr)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JExpr -> m JExpr)
-> Data JExpr
JExpr -> DataType
JExpr -> Constr
(forall b. Data b => b -> b) -> JExpr -> JExpr
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JExpr -> c JExpr
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JExpr
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) -> JExpr -> u
forall u. (forall d. Data d => d -> u) -> JExpr -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JExpr -> m JExpr
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JExpr -> m JExpr
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JExpr
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JExpr -> c JExpr
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JExpr)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JExpr)
$cTypeExpr :: Constr
$cAntiExpr :: Constr
$cUnsatExpr :: Constr
$cApplExpr :: Constr
$cNewExpr :: Constr
$cIfExpr :: Constr
$cPPostExpr :: Constr
$cInfixExpr :: Constr
$cIdxExpr :: Constr
$cSelExpr :: Constr
$cValExpr :: Constr
$tJExpr :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JExpr -> m JExpr
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JExpr -> m JExpr
gmapMp :: (forall d. Data d => d -> m d) -> JExpr -> m JExpr
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JExpr -> m JExpr
gmapM :: (forall d. Data d => d -> m d) -> JExpr -> m JExpr
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JExpr -> m JExpr
gmapQi :: Int -> (forall d. Data d => d -> u) -> JExpr -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JExpr -> u
gmapQ :: (forall d. Data d => d -> u) -> JExpr -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JExpr -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JExpr -> r
gmapT :: (forall b. Data b => b -> b) -> JExpr -> JExpr
$cgmapT :: (forall b. Data b => b -> b) -> JExpr -> JExpr
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JExpr)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JExpr)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JExpr)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JExpr)
dataTypeOf :: JExpr -> DataType
$cdataTypeOf :: JExpr -> DataType
toConstr :: JExpr -> Constr
$ctoConstr :: JExpr -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JExpr
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JExpr
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JExpr -> c JExpr
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JExpr -> c JExpr
$cp1Data :: Typeable JExpr
Data, Typeable)
data JVal = JVar Ident
| JList [JExpr]
| JDouble SaneDouble
| JInt Integer
| JStr String
| JRegEx String
| JHash (M.Map String 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
/= :: JVal -> JVal -> Bool
$c/= :: JVal -> JVal -> Bool
== :: JVal -> JVal -> Bool
$c== :: JVal -> JVal -> Bool
Eq, Eq JVal
Eq JVal =>
(JVal -> JVal -> Ordering)
-> (JVal -> JVal -> Bool)
-> (JVal -> JVal -> Bool)
-> (JVal -> JVal -> Bool)
-> (JVal -> JVal -> Bool)
-> (JVal -> JVal -> JVal)
-> (JVal -> JVal -> JVal)
-> Ord JVal
JVal -> JVal -> Bool
JVal -> JVal -> Ordering
JVal -> JVal -> JVal
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
min :: JVal -> JVal -> JVal
$cmin :: JVal -> JVal -> JVal
max :: JVal -> JVal -> JVal
$cmax :: JVal -> JVal -> JVal
>= :: JVal -> JVal -> Bool
$c>= :: JVal -> JVal -> Bool
> :: JVal -> JVal -> Bool
$c> :: JVal -> JVal -> Bool
<= :: JVal -> JVal -> Bool
$c<= :: JVal -> JVal -> Bool
< :: JVal -> JVal -> Bool
$c< :: JVal -> JVal -> Bool
compare :: JVal -> JVal -> Ordering
$ccompare :: JVal -> JVal -> Ordering
$cp1Ord :: Eq JVal
Ord, Int -> JVal -> [Char] -> [Char]
[JVal] -> [Char] -> [Char]
JVal -> [Char]
(Int -> JVal -> [Char] -> [Char])
-> (JVal -> [Char]) -> ([JVal] -> [Char] -> [Char]) -> Show JVal
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [JVal] -> [Char] -> [Char]
$cshowList :: [JVal] -> [Char] -> [Char]
show :: JVal -> [Char]
$cshow :: JVal -> [Char]
showsPrec :: Int -> JVal -> [Char] -> [Char]
$cshowsPrec :: Int -> JVal -> [Char] -> [Char]
Show, Typeable JVal
DataType
Constr
Typeable JVal =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JVal -> c JVal)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JVal)
-> (JVal -> Constr)
-> (JVal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JVal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JVal))
-> ((forall b. Data b => b -> b) -> JVal -> JVal)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r)
-> (forall u. (forall d. Data d => d -> u) -> JVal -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JVal -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JVal -> m JVal)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JVal -> m JVal)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JVal -> m JVal)
-> Data JVal
JVal -> DataType
JVal -> Constr
(forall b. Data b => b -> b) -> JVal -> JVal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JVal -> c JVal
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JVal
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) -> JVal -> u
forall u. (forall d. Data d => d -> u) -> JVal -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JVal -> m JVal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JVal -> m JVal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JVal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JVal -> c JVal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JVal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JVal)
$cUnsatVal :: Constr
$cJFunc :: Constr
$cJHash :: Constr
$cJRegEx :: Constr
$cJStr :: Constr
$cJInt :: Constr
$cJDouble :: Constr
$cJList :: Constr
$cJVar :: Constr
$tJVal :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JVal -> m JVal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JVal -> m JVal
gmapMp :: (forall d. Data d => d -> m d) -> JVal -> m JVal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JVal -> m JVal
gmapM :: (forall d. Data d => d -> m d) -> JVal -> m JVal
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JVal -> m JVal
gmapQi :: Int -> (forall d. Data d => d -> u) -> JVal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JVal -> u
gmapQ :: (forall d. Data d => d -> u) -> JVal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JVal -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JVal -> r
gmapT :: (forall b. Data b => b -> b) -> JVal -> JVal
$cgmapT :: (forall b. Data b => b -> b) -> JVal -> JVal
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JVal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JVal)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JVal)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JVal)
dataTypeOf :: JVal -> DataType
$cdataTypeOf :: JVal -> DataType
toConstr :: JVal -> Constr
$ctoConstr :: JVal -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JVal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JVal
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JVal -> c JVal
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JVal -> c JVal
$cp1Data :: Typeable JVal
Data, Typeable)
newtype SaneDouble = SaneDouble Double deriving (Typeable SaneDouble
DataType
Constr
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 -> DataType
SaneDouble -> Constr
(forall b. Data b => b -> b) -> SaneDouble -> SaneDouble
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SaneDouble -> c SaneDouble
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSaneDouble :: Constr
$tSaneDouble :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
gmapQi :: Int -> (forall d. Data d => d -> u) -> SaneDouble -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SaneDouble -> u
gmapQ :: (forall d. Data d => d -> u) -> SaneDouble -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SaneDouble -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
gmapT :: (forall b. Data b => b -> b) -> SaneDouble -> SaneDouble
$cgmapT :: (forall b. Data b => b -> b) -> SaneDouble -> SaneDouble
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SaneDouble)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SaneDouble)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SaneDouble)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SaneDouble)
dataTypeOf :: SaneDouble -> DataType
$cdataTypeOf :: SaneDouble -> DataType
toConstr :: SaneDouble -> Constr
$ctoConstr :: SaneDouble -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SaneDouble
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SaneDouble
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SaneDouble -> c SaneDouble
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SaneDouble -> c SaneDouble
$cp1Data :: Typeable 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
fromRational :: Rational -> SaneDouble
$cfromRational :: Rational -> SaneDouble
recip :: SaneDouble -> SaneDouble
$crecip :: SaneDouble -> SaneDouble
/ :: SaneDouble -> SaneDouble -> SaneDouble
$c/ :: SaneDouble -> SaneDouble -> SaneDouble
$cp1Fractional :: Num 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
fromInteger :: Integer -> SaneDouble
$cfromInteger :: Integer -> SaneDouble
signum :: SaneDouble -> SaneDouble
$csignum :: SaneDouble -> SaneDouble
abs :: SaneDouble -> SaneDouble
$cabs :: SaneDouble -> SaneDouble
negate :: SaneDouble -> SaneDouble
$cnegate :: SaneDouble -> SaneDouble
* :: SaneDouble -> SaneDouble -> SaneDouble
$c* :: SaneDouble -> SaneDouble -> SaneDouble
- :: SaneDouble -> SaneDouble -> SaneDouble
$c- :: SaneDouble -> SaneDouble -> SaneDouble
+ :: SaneDouble -> SaneDouble -> SaneDouble
$c+ :: SaneDouble -> SaneDouble -> SaneDouble
Num)
instance Eq SaneDouble where
(SaneDouble x :: Double
x) == :: SaneDouble -> SaneDouble -> Bool
== (SaneDouble y :: 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 x :: Double
x) (SaneDouble y :: 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 z :: 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 -> [Char]
show (SaneDouble x :: Double
x) = Double -> [Char]
forall a. Show a => a -> [Char]
show Double
x
newtype Ident = StrI String deriving (Ident -> Ident -> Bool
(Ident -> Ident -> Bool) -> (Ident -> Ident -> Bool) -> Eq Ident
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ident -> Ident -> Bool
$c/= :: Ident -> Ident -> Bool
== :: Ident -> Ident -> Bool
$c== :: Ident -> Ident -> Bool
Eq, Eq Ident
Eq Ident =>
(Ident -> Ident -> Ordering)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Bool)
-> (Ident -> Ident -> Ident)
-> (Ident -> Ident -> Ident)
-> Ord Ident
Ident -> Ident -> Bool
Ident -> Ident -> Ordering
Ident -> Ident -> Ident
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
min :: Ident -> Ident -> Ident
$cmin :: Ident -> Ident -> Ident
max :: Ident -> Ident -> Ident
$cmax :: Ident -> Ident -> Ident
>= :: Ident -> Ident -> Bool
$c>= :: Ident -> Ident -> Bool
> :: Ident -> Ident -> Bool
$c> :: Ident -> Ident -> Bool
<= :: Ident -> Ident -> Bool
$c<= :: Ident -> Ident -> Bool
< :: Ident -> Ident -> Bool
$c< :: Ident -> Ident -> Bool
compare :: Ident -> Ident -> Ordering
$ccompare :: Ident -> Ident -> Ordering
$cp1Ord :: Eq Ident
Ord, Int -> Ident -> [Char] -> [Char]
[Ident] -> [Char] -> [Char]
Ident -> [Char]
(Int -> Ident -> [Char] -> [Char])
-> (Ident -> [Char]) -> ([Ident] -> [Char] -> [Char]) -> Show Ident
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Ident] -> [Char] -> [Char]
$cshowList :: [Ident] -> [Char] -> [Char]
show :: Ident -> [Char]
$cshow :: Ident -> [Char]
showsPrec :: Int -> Ident -> [Char] -> [Char]
$cshowsPrec :: Int -> Ident -> [Char] -> [Char]
Show, Typeable Ident
DataType
Constr
Typeable Ident =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident)
-> (Ident -> Constr)
-> (Ident -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident))
-> ((forall b. Data b => b -> b) -> Ident -> Ident)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ident -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident)
-> Data Ident
Ident -> DataType
Ident -> Constr
(forall b. Data b => b -> b) -> Ident -> Ident
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
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) -> Ident -> u
forall u. (forall d. Data d => d -> u) -> Ident -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
$cStrI :: Constr
$tIdent :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapMp :: (forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapM :: (forall d. Data d => d -> m d) -> Ident -> m Ident
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ident -> m Ident
gmapQi :: Int -> (forall d. Data d => d -> u) -> Ident -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
gmapQ :: (forall d. Data d => d -> u) -> Ident -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ident -> r
gmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
$cgmapT :: (forall b. Data b => b -> b) -> Ident -> Ident
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ident)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Ident)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ident)
dataTypeOf :: Ident -> DataType
$cdataTypeOf :: Ident -> DataType
toConstr :: Ident -> Constr
$ctoConstr :: Ident -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ident
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ident -> c Ident
$cp1Data :: Typeable Ident
Data, Typeable)
expr2stat :: JExpr -> JStat
expr2stat :: JExpr -> JStat
expr2stat (ApplExpr x :: JExpr
x y :: [JExpr]
y) = (JExpr -> [JExpr] -> JStat
ApplStat JExpr
x [JExpr]
y)
expr2stat (IfExpr x :: JExpr
x y :: JExpr
y z :: JExpr
z) = JExpr -> JStat -> JStat -> JStat
IfStat JExpr
x (JExpr -> JStat
expr2stat JExpr
y) (JExpr -> JStat
expr2stat JExpr
z)
expr2stat (PPostExpr b :: Bool
b s :: [Char]
s x :: JExpr
x) = Bool -> [Char] -> JExpr -> JStat
PPostStat Bool
b [Char]
s JExpr
x
expr2stat (AntiExpr x :: [Char]
x) = [Char] -> JStat
AntiStat [Char]
x
expr2stat _ = JStat
nullStat
class JMacro a where
jtoGADT :: a -> JMGadt a
jfromGADT :: JMGadt a -> a
instance JMacro Ident where
jtoGADT :: Ident -> JMGadt Ident
jtoGADT = Ident -> JMGadt Ident
JMGId
jfromGADT :: JMGadt Ident -> Ident
jfromGADT (JMGId x :: Ident
x) = Ident
x
jfromGADT _ = [Char] -> Ident
forall a. HasCallStack => [Char] -> a
error "impossible"
instance JMacro JStat where
jtoGADT :: JStat -> JMGadt JStat
jtoGADT = JStat -> JMGadt JStat
JMGStat
jfromGADT :: JMGadt JStat -> JStat
jfromGADT (JMGStat x :: JStat
x) = JStat
x
jfromGADT _ = [Char] -> JStat
forall a. HasCallStack => [Char] -> a
error "impossible"
instance JMacro JExpr where
jtoGADT :: JExpr -> JMGadt JExpr
jtoGADT = JExpr -> JMGadt JExpr
JMGExpr
jfromGADT :: JMGadt JExpr -> JExpr
jfromGADT (JMGExpr x :: JExpr
x) = JExpr
x
jfromGADT _ = [Char] -> JExpr
forall a. HasCallStack => [Char] -> a
error "impossible"
instance JMacro JVal where
jtoGADT :: JVal -> JMGadt JVal
jtoGADT = JVal -> JMGadt JVal
JMGVal
jfromGADT :: JMGadt JVal -> JVal
jfromGADT (JMGVal x :: JVal
x) = JVal
x
jfromGADT _ = [Char] -> JVal
forall a. HasCallStack => [Char] -> a
error "impossible"
data JMGadt a where
JMGId :: Ident -> JMGadt Ident
JMGStat :: JStat -> JMGadt JStat
JMGExpr :: JExpr -> JMGadt JExpr
JMGVal :: JVal -> JMGadt JVal
composOp :: Compos t => (forall a. t a -> t a) -> t b -> t b
composOp :: (forall a. t a -> t a) -> t b -> t b
composOp f :: forall a. t a -> t a
f = Identity (t b) -> t b
forall a. Identity a -> a
runIdentity (Identity (t b) -> t b) -> (t b -> Identity (t b)) -> t b -> t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. t a -> Identity (t a)) -> t b -> Identity (t b)
forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM (t a -> Identity (t a)
forall a. a -> Identity a
Identity (t a -> Identity (t a)) -> (t a -> t a) -> t a -> Identity (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> t a
forall a. t a -> t a
f)
composOpM :: (Compos t, Monad m) => (forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM :: (forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM = (forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. t a -> m (t a))
-> t b
-> m (t b)
forall (t :: * -> *) (m :: * -> *) c.
Compos t =>
(forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. t a -> m (t a))
-> t c
-> m (t c)
compos forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. m (a -> b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
composOpM_ :: (Compos t, Monad m) => (forall a. t a -> m ()) -> t b -> m ()
composOpM_ :: (forall a. t a -> m ()) -> t b -> m ()
composOpM_ = m ()
-> (m () -> m () -> m ()) -> (forall a. t a -> m ()) -> t b -> m ()
forall (t :: * -> *) b c.
Compos t =>
b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
composOpFold (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
composOpFold :: Compos t => b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
composOpFold :: b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
composOpFold z :: b
z c :: b -> b -> b
c f :: forall a. t a -> b
f = C b (t c) -> b
forall b a. C b a -> b
unC (C b (t c) -> b) -> (t c -> C b (t c)) -> t c -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> C b a)
-> (forall a b. C b (a -> b) -> C b a -> C b b)
-> (forall a. t a -> C b (t a))
-> t c
-> C b (t c)
forall (t :: * -> *) (m :: * -> *) c.
Compos t =>
(forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. t a -> m (t a))
-> t c
-> m (t c)
compos (\_ -> b -> C b a
forall b a. b -> C b a
C b
z) (\(C x) (C y) -> b -> C b b
forall b a. b -> C b a
C (b -> b -> b
c b
x b
y)) (b -> C b (t a)
forall b a. b -> C b a
C (b -> C b (t a)) -> (t a -> b) -> t a -> C b (t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> b
forall a. t a -> b
f)
newtype C b a = C { C b a -> b
unC :: b }
class Compos t where
compos :: (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. t a -> m (t a)) -> t c -> m (t c)
instance Compos JMGadt where
compos :: (forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. JMGadt a -> m (JMGadt a))
-> JMGadt c
-> m (JMGadt c)
compos = (forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. JMGadt a -> m (JMGadt a))
-> JMGadt c
-> m (JMGadt c)
forall (m :: * -> *) c.
(forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. JMGadt a -> m (JMGadt a))
-> JMGadt c
-> m (JMGadt c)
jmcompos
jmcompos :: forall m c. (forall a. a -> m a) -> (forall a b. m (a -> b) -> m a -> m b) -> (forall a. JMGadt a -> m (JMGadt a)) -> JMGadt c -> m (JMGadt c)
jmcompos :: (forall a. a -> m a)
-> (forall a b. m (a -> b) -> m a -> m b)
-> (forall a. JMGadt a -> m (JMGadt a))
-> JMGadt c
-> m (JMGadt c)
jmcompos ret :: forall a. a -> m a
ret app :: forall a b. m (a -> b) -> m a -> m b
app f' :: forall a. JMGadt a -> m (JMGadt a)
f' v :: JMGadt c
v =
case JMGadt c
v of
JMGId _ -> JMGadt c -> m (JMGadt c)
forall a. a -> m a
ret JMGadt c
v
JMGStat v' :: JStat
v' -> (JStat -> JMGadt JStat) -> m (JStat -> JMGadt JStat)
forall a. a -> m a
ret JStat -> JMGadt JStat
JMGStat m (JStat -> JMGadt JStat) -> m JStat -> m (JMGadt JStat)
forall a b. m (a -> b) -> m a -> m b
`app` case JStat
v' of
DeclStat i :: Ident
i t :: Maybe JLocalType
t -> (Ident -> Maybe JLocalType -> JStat)
-> m (Ident -> Maybe JLocalType -> JStat)
forall a. a -> m a
ret Ident -> Maybe JLocalType -> JStat
DeclStat m (Ident -> Maybe JLocalType -> JStat)
-> m Ident -> m (Maybe JLocalType -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
i m (Maybe JLocalType -> JStat) -> m (Maybe JLocalType) -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` Maybe JLocalType -> m (Maybe JLocalType)
forall a. a -> m a
ret Maybe JLocalType
t
ReturnStat i :: JExpr
i -> (JExpr -> JStat) -> m (JExpr -> JStat)
forall a. a -> m a
ret JExpr -> JStat
ReturnStat m (JExpr -> JStat) -> m JExpr -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
i
IfStat e :: JExpr
e s :: JStat
s s' :: JStat
s' -> (JExpr -> JStat -> JStat -> JStat)
-> m (JExpr -> JStat -> JStat -> JStat)
forall a. a -> m a
ret JExpr -> JStat -> JStat -> JStat
IfStat m (JExpr -> JStat -> JStat -> JStat)
-> m JExpr -> m (JStat -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JStat -> JStat -> JStat) -> m JStat -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s'
WhileStat b :: Bool
b e :: JExpr
e s :: JStat
s -> (JExpr -> JStat -> JStat) -> m (JExpr -> JStat -> JStat)
forall a. a -> m a
ret (Bool -> JExpr -> JStat -> JStat
WhileStat Bool
b) m (JExpr -> JStat -> JStat) -> m JExpr -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s
ForInStat b :: Bool
b i :: Ident
i e :: JExpr
e s :: JStat
s -> (Ident -> JExpr -> JStat -> JStat)
-> m (Ident -> JExpr -> JStat -> JStat)
forall a. a -> m a
ret (Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b) m (Ident -> JExpr -> JStat -> JStat)
-> m Ident -> m (JExpr -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
i m (JExpr -> JStat -> JStat) -> m JExpr -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s
SwitchStat e :: JExpr
e l :: [(JExpr, JStat)]
l d :: JStat
d -> (JExpr -> [(JExpr, JStat)] -> JStat -> JStat)
-> m (JExpr -> [(JExpr, JStat)] -> JStat -> JStat)
forall a. a -> m a
ret JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat m (JExpr -> [(JExpr, JStat)] -> JStat -> JStat)
-> m JExpr -> m ([(JExpr, JStat)] -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m ([(JExpr, JStat)] -> JStat -> JStat)
-> m [(JExpr, JStat)] -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` m [(JExpr, JStat)]
l' m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
d
where l' :: m [(JExpr, JStat)]
l' = ((JExpr, JStat) -> m (JExpr, JStat))
-> [(JExpr, JStat)] -> m [(JExpr, JStat)]
forall a. (a -> m a) -> [a] -> m [a]
mapM' (\(c :: JExpr
c,s :: JStat
s) -> (JExpr -> JStat -> (JExpr, JStat))
-> m (JExpr -> JStat -> (JExpr, JStat))
forall a. a -> m a
ret (,) m (JExpr -> JStat -> (JExpr, JStat))
-> m JExpr -> m (JStat -> (JExpr, JStat))
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
c m (JStat -> (JExpr, JStat)) -> m JStat -> m (JExpr, JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s) [(JExpr, JStat)]
l
BlockStat xs :: [JStat]
xs -> ([JStat] -> JStat) -> m ([JStat] -> JStat)
forall a. a -> m a
ret [JStat] -> JStat
BlockStat m ([JStat] -> JStat) -> m [JStat] -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` (JStat -> m JStat) -> [JStat] -> m [JStat]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JStat -> m JStat
forall b. JMacro b => b -> m b
f [JStat]
xs
ApplStat e :: JExpr
e xs :: [JExpr]
xs -> (JExpr -> [JExpr] -> JStat) -> m (JExpr -> [JExpr] -> JStat)
forall a. a -> m a
ret JExpr -> [JExpr] -> JStat
ApplStat m (JExpr -> [JExpr] -> JStat) -> m JExpr -> m ([JExpr] -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m ([JExpr] -> JStat) -> m [JExpr] -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` (JExpr -> m JExpr) -> [JExpr] -> m [JExpr]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JExpr -> m JExpr
forall b. JMacro b => b -> m b
f [JExpr]
xs
TryStat s :: JStat
s i :: Ident
i s1 :: JStat
s1 s2 :: JStat
s2 -> (JStat -> Ident -> JStat -> JStat -> JStat)
-> m (JStat -> Ident -> JStat -> JStat -> JStat)
forall a. a -> m a
ret JStat -> Ident -> JStat -> JStat -> JStat
TryStat m (JStat -> Ident -> JStat -> JStat -> JStat)
-> m JStat -> m (Ident -> JStat -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s m (Ident -> JStat -> JStat -> JStat)
-> m Ident -> m (JStat -> JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
i m (JStat -> JStat -> JStat) -> m JStat -> m (JStat -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s1 m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s2
PPostStat b :: Bool
b o :: [Char]
o e :: JExpr
e -> (JExpr -> JStat) -> m (JExpr -> JStat)
forall a. a -> m a
ret (Bool -> [Char] -> JExpr -> JStat
PPostStat Bool
b [Char]
o) m (JExpr -> JStat) -> m JExpr -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e
AssignStat e :: JExpr
e e' :: JExpr
e' -> (JExpr -> JExpr -> JStat) -> m (JExpr -> JExpr -> JStat)
forall a. a -> m a
ret JExpr -> JExpr -> JStat
AssignStat m (JExpr -> JExpr -> JStat) -> m JExpr -> m (JExpr -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JExpr -> JStat) -> m JExpr -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e'
UnsatBlock _ -> JStat -> m JStat
forall a. a -> m a
ret JStat
v'
AntiStat _ -> JStat -> m JStat
forall a. a -> m a
ret JStat
v'
ForeignStat i :: Ident
i t :: JLocalType
t -> (Ident -> JLocalType -> JStat) -> m (Ident -> JLocalType -> JStat)
forall a. a -> m a
ret Ident -> JLocalType -> JStat
ForeignStat m (Ident -> JLocalType -> JStat)
-> m Ident -> m (JLocalType -> JStat)
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
i m (JLocalType -> JStat) -> m JLocalType -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JLocalType -> m JLocalType
forall a. a -> m a
ret JLocalType
t
ContinueStat l :: Maybe [Char]
l -> JStat -> m JStat
forall a. a -> m a
ret (Maybe [Char] -> JStat
ContinueStat Maybe [Char]
l)
BreakStat l :: Maybe [Char]
l -> JStat -> m JStat
forall a. a -> m a
ret (Maybe [Char] -> JStat
BreakStat Maybe [Char]
l)
LabelStat l :: [Char]
l s :: JStat
s -> (JStat -> JStat) -> m (JStat -> JStat)
forall a. a -> m a
ret ([Char] -> JStat -> JStat
LabelStat [Char]
l) m (JStat -> JStat) -> m JStat -> m JStat
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s
JMGExpr v' :: JExpr
v' -> (JExpr -> JMGadt JExpr) -> m (JExpr -> JMGadt JExpr)
forall a. a -> m a
ret JExpr -> JMGadt JExpr
JMGExpr m (JExpr -> JMGadt JExpr) -> m JExpr -> m (JMGadt JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` case JExpr
v' of
ValExpr e :: JVal
e -> (JVal -> JExpr) -> m (JVal -> JExpr)
forall a. a -> m a
ret JVal -> JExpr
ValExpr m (JVal -> JExpr) -> m JVal -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JVal -> m JVal
forall b. JMacro b => b -> m b
f JVal
e
SelExpr e :: JExpr
e e' :: Ident
e' -> (JExpr -> Ident -> JExpr) -> m (JExpr -> Ident -> JExpr)
forall a. a -> m a
ret JExpr -> Ident -> JExpr
SelExpr m (JExpr -> Ident -> JExpr) -> m JExpr -> m (Ident -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (Ident -> JExpr) -> m Ident -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
e'
IdxExpr e :: JExpr
e e' :: JExpr
e' -> (JExpr -> JExpr -> JExpr) -> m (JExpr -> JExpr -> JExpr)
forall a. a -> m a
ret JExpr -> JExpr -> JExpr
IdxExpr m (JExpr -> JExpr -> JExpr) -> m JExpr -> m (JExpr -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JExpr -> JExpr) -> m JExpr -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e'
InfixExpr o :: [Char]
o e :: JExpr
e e' :: JExpr
e' -> (JExpr -> JExpr -> JExpr) -> m (JExpr -> JExpr -> JExpr)
forall a. a -> m a
ret ([Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
o) m (JExpr -> JExpr -> JExpr) -> m JExpr -> m (JExpr -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JExpr -> JExpr) -> m JExpr -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e'
PPostExpr b :: Bool
b o :: [Char]
o e :: JExpr
e -> (JExpr -> JExpr) -> m (JExpr -> JExpr)
forall a. a -> m a
ret (Bool -> [Char] -> JExpr -> JExpr
PPostExpr Bool
b [Char]
o) m (JExpr -> JExpr) -> m JExpr -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e
IfExpr e :: JExpr
e e' :: JExpr
e' e'' :: JExpr
e'' -> (JExpr -> JExpr -> JExpr -> JExpr)
-> m (JExpr -> JExpr -> JExpr -> JExpr)
forall a. a -> m a
ret JExpr -> JExpr -> JExpr -> JExpr
IfExpr m (JExpr -> JExpr -> JExpr -> JExpr)
-> m JExpr -> m (JExpr -> JExpr -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JExpr -> JExpr -> JExpr) -> m JExpr -> m (JExpr -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e' m (JExpr -> JExpr) -> m JExpr -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e''
NewExpr e :: JExpr
e -> (JExpr -> JExpr) -> m (JExpr -> JExpr)
forall a. a -> m a
ret JExpr -> JExpr
NewExpr m (JExpr -> JExpr) -> m JExpr -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e
ApplExpr e :: JExpr
e xs :: [JExpr]
xs -> (JExpr -> [JExpr] -> JExpr) -> m (JExpr -> [JExpr] -> JExpr)
forall a. a -> m a
ret JExpr -> [JExpr] -> JExpr
ApplExpr m (JExpr -> [JExpr] -> JExpr) -> m JExpr -> m ([JExpr] -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m ([JExpr] -> JExpr) -> m [JExpr] -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` (JExpr -> m JExpr) -> [JExpr] -> m [JExpr]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JExpr -> m JExpr
forall b. JMacro b => b -> m b
f [JExpr]
xs
AntiExpr _ -> JExpr -> m JExpr
forall a. a -> m a
ret JExpr
v'
TypeExpr b :: Bool
b e :: JExpr
e t :: JLocalType
t -> (JExpr -> JLocalType -> JExpr) -> m (JExpr -> JLocalType -> JExpr)
forall a. a -> m a
ret (Bool -> JExpr -> JLocalType -> JExpr
TypeExpr Bool
b) m (JExpr -> JLocalType -> JExpr)
-> m JExpr -> m (JLocalType -> JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` JExpr -> m JExpr
forall b. JMacro b => b -> m b
f JExpr
e m (JLocalType -> JExpr) -> m JLocalType -> m JExpr
forall a b. m (a -> b) -> m a -> m b
`app` JLocalType -> m JLocalType
forall a. a -> m a
ret JLocalType
t
UnsatExpr _ -> JExpr -> m JExpr
forall a. a -> m a
ret JExpr
v'
JMGVal v' :: JVal
v' -> (JVal -> JMGadt JVal) -> m (JVal -> JMGadt JVal)
forall a. a -> m a
ret JVal -> JMGadt JVal
JMGVal m (JVal -> JMGadt JVal) -> m JVal -> m (JMGadt JVal)
forall a b. m (a -> b) -> m a -> m b
`app` case JVal
v' of
JVar i :: Ident
i -> (Ident -> JVal) -> m (Ident -> JVal)
forall a. a -> m a
ret Ident -> JVal
JVar m (Ident -> JVal) -> m Ident -> m JVal
forall a b. m (a -> b) -> m a -> m b
`app` Ident -> m Ident
forall b. JMacro b => b -> m b
f Ident
i
JList xs :: [JExpr]
xs -> ([JExpr] -> JVal) -> m ([JExpr] -> JVal)
forall a. a -> m a
ret [JExpr] -> JVal
JList m ([JExpr] -> JVal) -> m [JExpr] -> m JVal
forall a b. m (a -> b) -> m a -> m b
`app` (JExpr -> m JExpr) -> [JExpr] -> m [JExpr]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JExpr -> m JExpr
forall b. JMacro b => b -> m b
f [JExpr]
xs
JDouble _ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
JInt _ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
JStr _ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
JRegEx _ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
JHash m :: Map [Char] JExpr
m -> (Map [Char] JExpr -> JVal) -> m (Map [Char] JExpr -> JVal)
forall a. a -> m a
ret Map [Char] JExpr -> JVal
JHash m (Map [Char] JExpr -> JVal) -> m (Map [Char] JExpr) -> m JVal
forall a b. m (a -> b) -> m a -> m b
`app` m (Map [Char] JExpr)
m'
where (ls :: [[Char]]
ls, vs :: [JExpr]
vs) = [([Char], JExpr)] -> ([[Char]], [JExpr])
forall a b. [(a, b)] -> ([a], [b])
unzip (Map [Char] JExpr -> [([Char], JExpr)]
forall k a. Map k a -> [(k, a)]
M.toList Map [Char] JExpr
m)
m' :: m (Map [Char] JExpr)
m' = ([JExpr] -> Map [Char] JExpr) -> m ([JExpr] -> Map [Char] JExpr)
forall a. a -> m a
ret ([([Char], JExpr)] -> Map [Char] JExpr
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList ([([Char], JExpr)] -> Map [Char] JExpr)
-> ([JExpr] -> [([Char], JExpr)]) -> [JExpr] -> Map [Char] JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [JExpr] -> [([Char], JExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
ls) m ([JExpr] -> Map [Char] JExpr)
-> m [JExpr] -> m (Map [Char] JExpr)
forall a b. m (a -> b) -> m a -> m b
`app` (JExpr -> m JExpr) -> [JExpr] -> m [JExpr]
forall a. (a -> m a) -> [a] -> m [a]
mapM' JExpr -> m JExpr
forall b. JMacro b => b -> m b
f [JExpr]
vs
JFunc xs :: [Ident]
xs s :: JStat
s -> ([Ident] -> JStat -> JVal) -> m ([Ident] -> JStat -> JVal)
forall a. a -> m a
ret [Ident] -> JStat -> JVal
JFunc m ([Ident] -> JStat -> JVal) -> m [Ident] -> m (JStat -> JVal)
forall a b. m (a -> b) -> m a -> m b
`app` (Ident -> m Ident) -> [Ident] -> m [Ident]
forall a. (a -> m a) -> [a] -> m [a]
mapM' Ident -> m Ident
forall b. JMacro b => b -> m b
f [Ident]
xs m (JStat -> JVal) -> m JStat -> m JVal
forall a b. m (a -> b) -> m a -> m b
`app` JStat -> m JStat
forall b. JMacro b => b -> m b
f JStat
s
UnsatVal _ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
where
mapM' :: forall a. (a -> m a) -> [a] -> m [a]
mapM' :: (a -> m a) -> [a] -> m [a]
mapM' g :: a -> m a
g = (a -> m [a] -> m [a]) -> m [a] -> [a] -> m [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
app (m ([a] -> [a]) -> m [a] -> m [a])
-> (a -> m ([a] -> [a])) -> a -> m [a] -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall a b. m (a -> b) -> m a -> m b
app ((a -> [a] -> [a]) -> m (a -> [a] -> [a])
forall a. a -> m a
ret (:)) (m a -> m ([a] -> [a])) -> (a -> m a) -> a -> m ([a] -> [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
g) ([a] -> m [a]
forall a. a -> m a
ret [])
f :: forall b. JMacro b => b -> m b
f :: b -> m b
f x :: b
x = (JMGadt b -> b) -> m (JMGadt b -> b)
forall a. a -> m a
ret JMGadt b -> b
forall a. JMacro a => JMGadt a -> a
jfromGADT m (JMGadt b -> b) -> m (JMGadt b) -> m b
forall a b. m (a -> b) -> m a -> m b
`app` JMGadt b -> m (JMGadt b)
forall a. JMGadt a -> m (JMGadt a)
f' (b -> JMGadt b
forall a. JMacro a => a -> JMGadt a
jtoGADT b
x)
class ToSat a where
toSat_ :: a -> [Ident] -> IdentSupply (JStat, [Ident])
instance ToSat [JStat] where
toSat_ :: [JStat] -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ f :: [JStat]
f vs :: [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall (m :: * -> *) a. Monad m => a -> m a
return ((JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ ([JStat] -> JStat
BlockStat [JStat]
f, [Ident] -> [Ident]
forall a. [a] -> [a]
reverse [Ident]
vs)
instance ToSat JStat where
toSat_ :: JStat -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ f :: JStat
f vs :: [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall (m :: * -> *) a. Monad m => a -> m a
return ((JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat
f, [Ident] -> [Ident]
forall a. [a] -> [a]
reverse [Ident]
vs)
instance ToSat JExpr where
toSat_ :: JExpr -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ f :: JExpr
f vs :: [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall (m :: * -> *) a. Monad m => a -> m a
return ((JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JExpr -> JStat
expr2stat JExpr
f, [Ident] -> [Ident]
forall a. [a] -> [a]
reverse [Ident]
vs)
instance ToSat [JExpr] where
toSat_ :: [JExpr] -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ f :: [JExpr]
f vs :: [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall (m :: * -> *) a. Monad m => a -> m a
return ((JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ ([JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ (JExpr -> JStat) -> [JExpr] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map JExpr -> JStat
expr2stat [JExpr]
f, [Ident] -> [Ident]
forall a. [a] -> [a]
reverse [Ident]
vs)
instance (ToSat a, b ~ JExpr) => ToSat (b -> a) where
toSat_ :: (b -> a) -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ f :: b -> a
f vs :: [Ident]
vs = State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident]))
-> State [Ident] (JStat, [Ident]) -> IdentSupply (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ do
Ident
x <- State [Ident] Ident
takeOne
IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ a -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ (b -> a
f (JVal -> b
JVal -> JExpr
ValExpr (JVal -> b) -> JVal -> b
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
x)) (Ident
xIdent -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
:[Ident]
vs)
jsSaturate :: (JMacro a) => Maybe String -> a -> a
jsSaturate :: Maybe [Char] -> a -> a
jsSaturate str :: Maybe [Char]
str x :: 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 -> State [Ident] a)
-> IdentSupply a -> State [Ident] a
forall a b. (a -> b) -> a -> b
$ a -> IdentSupply a
forall a. JMacro a => a -> IdentSupply a
jsSaturate_ a
x) (Maybe [Char] -> [Ident]
newIdentSupply Maybe [Char]
str)
jsSaturate_ :: (JMacro a) => a -> IdentSupply a
jsSaturate_ :: a -> IdentSupply a
jsSaturate_ e :: a
e = State [Ident] a -> IdentSupply a
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] a -> IdentSupply a)
-> State [Ident] a -> IdentSupply a
forall a b. (a -> b) -> a -> b
$ JMGadt a -> a
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt a -> a)
-> StateT [Ident] Identity (JMGadt a) -> State [Ident] a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMGadt a -> StateT [Ident] Identity (JMGadt a)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (a -> JMGadt a
forall a. JMacro a => a -> JMGadt a
jtoGADT a
e)
where
go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
go :: JMGadt a -> State [Ident] (JMGadt a)
go v :: JMGadt a
v = case JMGadt a
v of
JMGStat (UnsatBlock us :: IdentSupply JStat
us) -> JMGadt JStat -> State [Ident] (JMGadt JStat)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JMGadt JStat -> State [Ident] (JMGadt JStat))
-> State [Ident] (JMGadt JStat) -> State [Ident] (JMGadt JStat)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JStat -> JMGadt JStat
JMGStat (JStat -> JMGadt JStat)
-> StateT [Ident] Identity JStat -> State [Ident] (JMGadt JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentSupply JStat -> StateT [Ident] Identity JStat
forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JStat
us)
JMGExpr (UnsatExpr us :: IdentSupply JExpr
us) -> JMGadt JExpr -> State [Ident] (JMGadt JExpr)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JMGadt JExpr -> State [Ident] (JMGadt JExpr))
-> State [Ident] (JMGadt JExpr) -> State [Ident] (JMGadt JExpr)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JExpr -> JMGadt JExpr
JMGExpr (JExpr -> JMGadt JExpr)
-> StateT [Ident] Identity JExpr -> State [Ident] (JMGadt JExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentSupply JExpr -> StateT [Ident] Identity JExpr
forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JExpr
us)
JMGVal (UnsatVal us :: IdentSupply JVal
us) -> JMGadt JVal -> State [Ident] (JMGadt JVal)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JMGadt JVal -> State [Ident] (JMGadt JVal))
-> State [Ident] (JMGadt JVal) -> State [Ident] (JMGadt JVal)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JVal -> JMGadt JVal
JMGVal (JVal -> JMGadt JVal)
-> StateT [Ident] Identity JVal -> State [Ident] (JMGadt JVal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentSupply JVal -> StateT [Ident] Identity JVal
forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JVal
us)
_ -> (forall a. JMGadt a -> State [Ident] (JMGadt a))
-> JMGadt a -> State [Ident] (JMGadt a)
forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM forall a. JMGadt a -> State [Ident] (JMGadt a)
go JMGadt a
v
jsReplace_ :: JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ :: [(Ident, Ident)] -> a -> a
jsReplace_ xs :: [(Ident, Ident)]
xs e :: a
e = JMGadt a -> a
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt a -> a) -> JMGadt a -> a
forall a b. (a -> b) -> a -> b
$ JMGadt a -> JMGadt a
forall a. JMGadt a -> JMGadt a
go (a -> JMGadt a
forall a. JMacro a => a -> JMGadt a
jtoGADT a
e)
where
go :: forall a. JMGadt a -> JMGadt a
go :: JMGadt a -> JMGadt a
go v :: JMGadt a
v = case JMGadt a
v of
JMGId i :: Ident
i -> JMGadt a -> (Ident -> JMGadt a) -> Maybe Ident -> JMGadt a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe JMGadt a
v Ident -> JMGadt a
Ident -> JMGadt Ident
JMGId (Ident -> Map Ident Ident -> Maybe Ident
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Ident
i Map Ident Ident
mp)
_ -> (forall a. JMGadt a -> JMGadt a) -> JMGadt a -> JMGadt a
forall (t :: * -> *) b.
Compos t =>
(forall a. t a -> t a) -> t b -> t b
composOp forall a. JMGadt a -> JMGadt a
go JMGadt a
v
mp :: Map Ident Ident
mp = [(Ident, Ident)] -> Map Ident Ident
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Ident, Ident)]
xs
jsUnsat_ :: JMacro a => [Ident] -> a -> IdentSupply a
jsUnsat_ :: [Ident] -> a -> IdentSupply a
jsUnsat_ xs :: [Ident]
xs e :: a
e = State [Ident] a -> IdentSupply a
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] a -> IdentSupply a)
-> State [Ident] a -> IdentSupply a
forall a b. (a -> b) -> a -> b
$ do
(idents :: [Ident]
idents,is' :: [Ident]
is') <- Int -> [Ident] -> ([Ident], [Ident])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
xs) ([Ident] -> ([Ident], [Ident]))
-> StateT [Ident] Identity [Ident]
-> StateT [Ident] Identity ([Ident], [Ident])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT [Ident] Identity [Ident]
forall s (m :: * -> *). MonadState s m => m s
get
[Ident] -> StateT [Ident] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
is'
a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State [Ident] a) -> a -> State [Ident] a
forall a b. (a -> b) -> a -> b
$ [(Ident, Ident)] -> a -> a
forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ ([Ident] -> [Ident] -> [(Ident, Ident)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
xs [Ident]
idents) a
e
withHygiene :: JMacro a => (a -> a) -> a -> a
withHygiene :: (a -> a) -> a -> a
withHygiene f :: a -> a
f x :: a
x = JMGadt a -> a
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt a -> a) -> JMGadt a -> a
forall a b. (a -> b) -> a -> b
$ case a -> JMGadt a
forall a. JMacro a => a -> JMGadt a
jtoGADT a
x of
JMGExpr z :: JExpr
z -> JExpr -> JMGadt a
JExpr -> JMGadt JExpr
JMGExpr (JExpr -> JMGadt a) -> JExpr -> JMGadt a
forall a b. (a -> b) -> a -> b
$ IdentSupply JExpr -> JExpr
UnsatExpr (IdentSupply JExpr -> JExpr) -> IdentSupply JExpr -> JExpr
forall a b. (a -> b) -> a -> b
$ a -> IdentSupply a
inScope a
JExpr
z
JMGStat z :: JStat
z -> JStat -> JMGadt a
JStat -> JMGadt JStat
JMGStat (JStat -> JMGadt a) -> JStat -> JMGadt a
forall a b. (a -> b) -> a -> b
$ IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat) -> IdentSupply JStat -> JStat
forall a b. (a -> b) -> a -> b
$ a -> IdentSupply a
inScope a
JStat
z
JMGVal z :: JVal
z -> JVal -> JMGadt a
JVal -> JMGadt JVal
JMGVal (JVal -> JMGadt a) -> JVal -> JMGadt a
forall a b. (a -> b) -> a -> b
$ IdentSupply JVal -> JVal
UnsatVal (IdentSupply JVal -> JVal) -> IdentSupply JVal -> JVal
forall a b. (a -> b) -> a -> b
$ a -> IdentSupply a
inScope a
JVal
z
JMGId _ -> a -> JMGadt a
forall a. JMacro a => a -> JMGadt a
jtoGADT (a -> JMGadt a) -> a -> JMGadt a
forall a b. (a -> b) -> a -> b
$ a -> a
f a
x
where
inScope :: a -> IdentSupply a
inScope z :: a
z = State [Ident] a -> IdentSupply a
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] a -> IdentSupply a)
-> State [Ident] a -> IdentSupply a
forall a b. (a -> b) -> a -> b
$ do
Int -> [Ident] -> ([Ident], [Ident])
forall a. Int -> [a] -> ([a], [a])
splitAt 1 ([Ident] -> ([Ident], [Ident]))
-> StateT [Ident] Identity [Ident]
-> StateT [Ident] Identity ([Ident], [Ident])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` StateT [Ident] Identity [Ident]
forall s (m :: * -> *). MonadState s m => m s
get StateT [Ident] Identity ([Ident], [Ident])
-> (([Ident], [Ident]) -> State [Ident] a) -> State [Ident] a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
([StrI a :: [Char]
a], b :: [Ident]
b) -> do
[Ident] -> StateT [Ident] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
b
a -> State [Ident] a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State [Ident] a) -> a -> State [Ident] a
forall a b. (a -> b) -> a -> b
$ [Char] -> (a -> a) -> a -> a
forall a. JMacro a => [Char] -> (a -> a) -> a -> a
withHygiene_ [Char]
a a -> a
f a
z
_ -> [Char] -> State [Ident] a
forall a. HasCallStack => [Char] -> a
error "Not as string"
withHygiene_ :: JMacro a => String -> (a -> a) -> a -> a
withHygiene_ :: [Char] -> (a -> a) -> a -> a
withHygiene_ un :: [Char]
un f :: a -> a
f x :: a
x = JMGadt a -> a
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt a -> a) -> JMGadt a -> a
forall a b. (a -> b) -> a -> b
$ case a -> JMGadt a
forall a. JMacro a => a -> JMGadt a
jtoGADT a
x of
JMGStat _ -> JStat -> JMGadt a
forall a. JMacro a => a -> JMGadt a
jtoGADT (JStat -> JMGadt a) -> JStat -> JMGadt a
forall a b. (a -> b) -> a -> b
$ IdentSupply JStat -> JStat
UnsatBlock ([Ident] -> a -> IdentSupply a
forall a. JMacro a => [Ident] -> a -> IdentSupply a
jsUnsat_ [Ident]
is' a
x'')
JMGExpr _ -> JExpr -> JMGadt a
forall a. JMacro a => a -> JMGadt a
jtoGADT (JExpr -> JMGadt a) -> JExpr -> JMGadt a
forall a b. (a -> b) -> a -> b
$ IdentSupply JExpr -> JExpr
UnsatExpr ([Ident] -> a -> IdentSupply a
forall a. JMacro a => [Ident] -> a -> IdentSupply a
jsUnsat_ [Ident]
is' a
x'')
JMGVal _ -> JVal -> JMGadt a
forall a. JMacro a => a -> JMGadt a
jtoGADT (JVal -> JMGadt a) -> JVal -> JMGadt a
forall a b. (a -> b) -> a -> b
$ IdentSupply JVal -> JVal
UnsatVal ([Ident] -> a -> IdentSupply a
forall a. JMacro a => [Ident] -> a -> IdentSupply a
jsUnsat_ [Ident]
is' a
x'')
JMGId _ -> a -> JMGadt a
forall a. JMacro a => a -> JMGadt a
jtoGADT (a -> JMGadt a) -> a -> JMGadt a
forall a b. (a -> b) -> a -> b
$ a -> a
f a
x
where
(x' :: a
x', (StrI l :: [Char]
l : _)) = State [Ident] a -> [Ident] -> (a, [Ident])
forall s a. State s a -> s -> (a, s)
runState (IdentSupply a -> State [Ident] a
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply a -> State [Ident] a)
-> IdentSupply a -> State [Ident] a
forall a b. (a -> b) -> a -> b
$ a -> IdentSupply a
forall a. JMacro a => a -> IdentSupply a
jsSaturate_ a
x) [Ident]
is
is' :: [Ident]
is' = Int -> [Ident] -> [Ident]
forall a. Int -> [a] -> [a]
take Int
lastVal [Ident]
is
x'' :: a
x'' = a -> a
f a
x'
lastVal :: Int
lastVal = [Char] -> [Char] -> Int
forall a. (HasCallStack, Read a) => [Char] -> [Char] -> a
readNote ("inSat" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
un) ([Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '_') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
l) :: Int
is :: [Ident]
is = Maybe [Char] -> [Ident]
newIdentSupply (Maybe [Char] -> [Ident]) -> Maybe [Char] -> [Ident]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ("inSat" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
un)
scopify :: JStat -> JStat
scopify :: JStat -> JStat
scopify x :: JStat
x = StateT [Ident] Identity JStat -> [Ident] -> JStat
forall s a. State s a -> s -> a
evalState (JMGadt JStat -> JStat
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt JStat -> JStat)
-> State [Ident] (JMGadt JStat) -> StateT [Ident] Identity JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMGadt JStat -> State [Ident] (JMGadt JStat)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JStat -> JMGadt JStat
forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
x)) (Maybe [Char] -> [Ident]
newIdentSupply Maybe [Char]
forall a. Maybe a
Nothing)
where go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
go :: JMGadt a -> State [Ident] (JMGadt a)
go v :: JMGadt a
v = case JMGadt a
v of
(JMGStat (BlockStat ss :: [JStat]
ss)) -> JStat -> JMGadt JStat
JMGStat (JStat -> JMGadt JStat)
-> ([JStat] -> JStat) -> [JStat] -> JMGadt JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStat] -> JStat
BlockStat ([JStat] -> JMGadt JStat)
-> StateT [Ident] Identity [JStat] -> State [Ident] (JMGadt JStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[JStat] -> StateT [Ident] Identity [JStat]
blocks [JStat]
ss
where blocks :: [JStat] -> StateT [Ident] Identity [JStat]
blocks [] = [JStat] -> StateT [Ident] Identity [JStat]
forall (m :: * -> *) a. Monad m => a -> m a
return []
blocks (DeclStat (StrI i :: [Char]
i) t :: Maybe JLocalType
t : xs :: [JStat]
xs) = case [Char]
i of
('!':'!':i' :: [Char]
i') -> (Ident -> Maybe JLocalType -> JStat
DeclStat ([Char] -> Ident
StrI [Char]
i') Maybe JLocalType
tJStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
:) ([JStat] -> [JStat])
-> StateT [Ident] Identity [JStat]
-> StateT [Ident] Identity [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JStat] -> StateT [Ident] Identity [JStat]
blocks [JStat]
xs
('!':i' :: [Char]
i') -> (Ident -> Maybe JLocalType -> JStat
DeclStat ([Char] -> Ident
StrI [Char]
i') Maybe JLocalType
tJStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
:) ([JStat] -> [JStat])
-> StateT [Ident] Identity [JStat]
-> StateT [Ident] Identity [JStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JStat] -> StateT [Ident] Identity [JStat]
blocks [JStat]
xs
_ -> StateT [Ident] Identity [Ident]
forall s (m :: * -> *). MonadState s m => m s
get StateT [Ident] Identity [Ident]
-> ([Ident] -> StateT [Ident] Identity [JStat])
-> StateT [Ident] Identity [JStat]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(newI :: Ident
newI:st :: [Ident]
st) -> do
[Ident] -> StateT [Ident] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
st
[JStat]
rest <- [JStat] -> StateT [Ident] Identity [JStat]
blocks [JStat]
xs
[JStat] -> StateT [Ident] Identity [JStat]
forall (m :: * -> *) a. Monad m => a -> m a
return ([JStat] -> StateT [Ident] Identity [JStat])
-> [JStat] -> StateT [Ident] Identity [JStat]
forall a b. (a -> b) -> a -> b
$ [Ident -> Maybe JLocalType -> JStat
DeclStat Ident
newI Maybe JLocalType
t JStat -> JStat -> JStat
forall a. Monoid a => a -> a -> a
`mappend` [(Ident, Ident)] -> JStat -> JStat
forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ [([Char] -> Ident
StrI [Char]
i, Ident
newI)] ([JStat] -> JStat
BlockStat [JStat]
rest)]
_ -> [Char] -> StateT [Ident] Identity [JStat]
forall a. HasCallStack => [Char] -> a
error "scopify"
blocks (x' :: JStat
x':xs :: [JStat]
xs) = (JMGadt JStat -> JStat
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt JStat -> JStat)
-> State [Ident] (JMGadt JStat) -> StateT [Ident] Identity JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMGadt JStat -> State [Ident] (JMGadt JStat)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JStat -> JMGadt JStat
forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
x')) StateT [Ident] Identity JStat
-> StateT [Ident] Identity [JStat]
-> StateT [Ident] Identity [JStat]
forall a.
StateT [Ident] Identity a
-> StateT [Ident] Identity [a] -> StateT [Ident] Identity [a]
<:> [JStat] -> StateT [Ident] Identity [JStat]
blocks [JStat]
xs
<:> :: StateT [Ident] Identity a
-> StateT [Ident] Identity [a] -> StateT [Ident] Identity [a]
(<:>) = (a -> [a] -> [a])
-> StateT [Ident] Identity a
-> StateT [Ident] Identity [a]
-> StateT [Ident] Identity [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:)
(JMGStat (ForInStat b :: Bool
b (StrI i :: [Char]
i) e :: JExpr
e s :: JStat
s)) -> StateT [Ident] Identity [Ident]
forall s (m :: * -> *). MonadState s m => m s
get StateT [Ident] Identity [Ident]
-> ([Ident] -> State [Ident] (JMGadt JStat))
-> State [Ident] (JMGadt JStat)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(newI :: Ident
newI:st :: [Ident]
st) -> do
[Ident] -> StateT [Ident] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
st
JStat
rest <- JMGadt JStat -> JStat
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt JStat -> JStat)
-> State [Ident] (JMGadt JStat) -> StateT [Ident] Identity JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMGadt JStat -> State [Ident] (JMGadt JStat)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JStat -> JMGadt JStat
forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s)
JMGadt JStat -> State [Ident] (JMGadt JStat)
forall (m :: * -> *) a. Monad m => a -> m a
return (JMGadt JStat -> State [Ident] (JMGadt JStat))
-> JMGadt JStat -> State [Ident] (JMGadt JStat)
forall a b. (a -> b) -> a -> b
$ JStat -> JMGadt JStat
JMGStat (JStat -> JMGadt JStat)
-> (JStat -> JStat) -> JStat -> JMGadt JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b Ident
newI JExpr
e (JStat -> JMGadt JStat) -> JStat -> JMGadt JStat
forall a b. (a -> b) -> a -> b
$ [(Ident, Ident)] -> JStat -> JStat
forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ [([Char] -> Ident
StrI [Char]
i, Ident
newI)] JStat
rest
_ -> [Char] -> State [Ident] (JMGadt JStat)
forall a. HasCallStack => [Char] -> a
error "scopify2"
(JMGStat (TryStat s :: JStat
s (StrI i :: [Char]
i) s1 :: JStat
s1 s2 :: JStat
s2)) -> StateT [Ident] Identity [Ident]
forall s (m :: * -> *). MonadState s m => m s
get StateT [Ident] Identity [Ident]
-> ([Ident] -> State [Ident] (JMGadt JStat))
-> State [Ident] (JMGadt JStat)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(newI :: Ident
newI:st :: [Ident]
st) -> do
[Ident] -> StateT [Ident] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
st
JStat
t <- JMGadt JStat -> JStat
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt JStat -> JStat)
-> State [Ident] (JMGadt JStat) -> StateT [Ident] Identity JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMGadt JStat -> State [Ident] (JMGadt JStat)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JStat -> JMGadt JStat
forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s)
JStat
c <- JMGadt JStat -> JStat
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt JStat -> JStat)
-> State [Ident] (JMGadt JStat) -> StateT [Ident] Identity JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMGadt JStat -> State [Ident] (JMGadt JStat)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JStat -> JMGadt JStat
forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s1)
JStat
f <- JMGadt JStat -> JStat
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt JStat -> JStat)
-> State [Ident] (JMGadt JStat) -> StateT [Ident] Identity JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMGadt JStat -> State [Ident] (JMGadt JStat)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JStat -> JMGadt JStat
forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s2)
JMGadt JStat -> State [Ident] (JMGadt JStat)
forall (m :: * -> *) a. Monad m => a -> m a
return (JMGadt JStat -> State [Ident] (JMGadt JStat))
-> (JStat -> JMGadt JStat) -> JStat -> State [Ident] (JMGadt JStat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> JMGadt JStat
JMGStat (JStat -> JMGadt JStat)
-> (JStat -> JStat) -> JStat -> JMGadt JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> Ident -> JStat -> JStat -> JStat
TryStat JStat
t Ident
newI ([(Ident, Ident)] -> JStat -> JStat
forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ [([Char] -> Ident
StrI [Char]
i, Ident
newI)] JStat
c) (JStat -> State [Ident] (JMGadt JStat))
-> JStat -> State [Ident] (JMGadt JStat)
forall a b. (a -> b) -> a -> b
$ JStat
f
_ -> [Char] -> State [Ident] (JMGadt JStat)
forall a. HasCallStack => [Char] -> a
error "scopify3"
(JMGExpr (ValExpr (JFunc is :: [Ident]
is s :: JStat
s))) -> do
[Ident]
st <- StateT [Ident] Identity [Ident]
forall s (m :: * -> *). MonadState s m => m s
get
let (newIs :: [Ident]
newIs,newSt :: [Ident]
newSt) = Int -> [Ident] -> ([Ident], [Ident])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
is) [Ident]
st
[Ident] -> StateT [Ident] Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([Ident]
newSt)
JStat
rest <- JMGadt JStat -> JStat
forall a. JMacro a => JMGadt a -> a
jfromGADT (JMGadt JStat -> JStat)
-> State [Ident] (JMGadt JStat) -> StateT [Ident] Identity JStat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JMGadt JStat -> State [Ident] (JMGadt JStat)
forall a. JMGadt a -> State [Ident] (JMGadt a)
go (JStat -> JMGadt JStat
forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s)
JMGadt JExpr -> State [Ident] (JMGadt JExpr)
forall (m :: * -> *) a. Monad m => a -> m a
return (JMGadt JExpr -> State [Ident] (JMGadt JExpr))
-> (JVal -> JMGadt JExpr) -> JVal -> State [Ident] (JMGadt JExpr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> JMGadt JExpr
JMGExpr (JExpr -> JMGadt JExpr) -> (JVal -> JExpr) -> JVal -> JMGadt JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JVal -> JExpr
ValExpr (JVal -> State [Ident] (JMGadt a))
-> JVal -> State [Ident] (JMGadt a)
forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
newIs (JStat -> JVal) -> JStat -> JVal
forall a b. (a -> b) -> a -> b
$ ([(Ident, Ident)] -> JStat -> JStat
forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ ([(Ident, Ident)] -> JStat -> JStat)
-> [(Ident, Ident)] -> JStat -> JStat
forall a b. (a -> b) -> a -> b
$ [Ident] -> [Ident] -> [(Ident, Ident)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
is [Ident]
newIs) JStat
rest
_ -> (forall a. JMGadt a -> State [Ident] (JMGadt a))
-> JMGadt a -> State [Ident] (JMGadt a)
forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM forall a. JMGadt a -> State [Ident] (JMGadt a)
go JMGadt a
v
renderJs :: (JsToDoc a, JMacro a) => a -> Doc
renderJs :: a -> Doc
renderJs = a -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc (a -> Doc) -> (a -> a) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> a -> a
forall a. JMacro a => Maybe [Char] -> a -> a
jsSaturate Maybe [Char]
forall a. Maybe a
Nothing
renderPrefixJs :: (JsToDoc a, JMacro a) => String -> a -> Doc
renderPrefixJs :: [Char] -> a -> Doc
renderPrefixJs pfx :: [Char]
pfx = a -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc (a -> Doc) -> (a -> a) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Char] -> a -> a
forall a. JMacro a => Maybe [Char] -> a -> a
jsSaturate ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ "jmId_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
pfx)
braceNest :: Doc -> Doc
braceNest :: Doc -> Doc
braceNest x :: Doc
x = Char -> Doc
char '{' Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest 2 Doc
x Doc -> Doc -> Doc
$$ Char -> Doc
char '}'
braceNest' :: Doc -> Doc
braceNest' :: Doc -> Doc
braceNest' x :: Doc
x = Int -> Doc -> Doc
nest 2 (Char -> Doc
char '{' Doc -> Doc -> Doc
$+$ Doc
x) Doc -> Doc -> Doc
$$ Char -> Doc
char '}'
class JsToDoc a
where jsToDoc :: a -> Doc
instance JsToDoc JStat where
jsToDoc :: JStat -> Doc
jsToDoc (IfStat cond :: JExpr
cond x :: JStat
x y :: JStat
y) = Text -> Doc
text "if" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
cond) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
x) Doc -> Doc -> Doc
$$ Doc
mbElse
where mbElse :: Doc
mbElse | JStat
y JStat -> JStat -> Bool
forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Doc
PP.empty
| Bool
otherwise = Text -> Doc
text "else" Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
y)
jsToDoc (DeclStat x :: Ident
x t :: Maybe JLocalType
t) = Text -> Doc
text "var" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rest
where rest :: Doc
rest = case Maybe JLocalType
t of
Nothing -> Text -> Doc
text ""
Just tp :: JLocalType
tp -> Text -> Doc
text " /* ::" Doc -> Doc -> Doc
<+> JLocalType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JLocalType
tp Doc -> Doc -> Doc
<+> Text -> Doc
text "*/"
jsToDoc (WhileStat False p :: JExpr
p b :: JStat
b) = Text -> Doc
text "while" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
p) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
b)
jsToDoc (WhileStat True p :: JExpr
p b :: JStat
b) = (Text -> Doc
text "do" Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
b)) Doc -> Doc -> Doc
$+$ Text -> Doc
text "while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
p)
jsToDoc (UnsatBlock e :: IdentSupply JStat
e) = JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc (JStat -> Doc) -> JStat -> Doc
forall a b. (a -> b) -> a -> b
$ IdentSupply JStat -> JStat
forall a. IdentSupply a -> a
sat_ IdentSupply JStat
e
jsToDoc (BreakStat l :: Maybe [Char]
l) = Doc -> ([Char] -> Doc) -> Maybe [Char] -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Doc
text "break") ((Doc -> Doc -> Doc
(<+>) (Doc -> Doc -> Doc) -> (Text -> Doc) -> Text -> Text -> Doc
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Doc
text) "break" (Text -> Doc) -> ([Char] -> Text) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) Maybe [Char]
l
jsToDoc (ContinueStat l :: Maybe [Char]
l) = Doc -> ([Char] -> Doc) -> Maybe [Char] -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Doc
text "continue") ((Doc -> Doc -> Doc
(<+>) (Doc -> Doc -> Doc) -> (Text -> Doc) -> Text -> Text -> Doc
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Doc
text) "continue" (Text -> Doc) -> ([Char] -> Text) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) Maybe [Char]
l
jsToDoc (LabelStat l :: [Char]
l s :: JStat
s) = Text -> Doc
text ([Char] -> Text
T.pack [Char]
l) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char ':' Doc -> Doc -> Doc
$$ JStat -> Doc
printBS JStat
s
where
printBS :: JStat -> Doc
printBS (BlockStat ss :: [JStat]
ss) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [JStat] -> [Doc]
forall a. JsToDoc a => [a] -> [Doc]
interSemi ([JStat] -> [Doc]) -> [JStat] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [JStat] -> [JStat]
flattenBlocks [JStat]
ss
printBS x :: JStat
x = JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
x
interSemi :: [a] -> [Doc]
interSemi [x :: a
x] = [a -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc a
x]
interSemi [] = []
interSemi (x :: a
x:xs :: [a]
xs) = (a -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc a
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [a] -> [Doc]
interSemi [a]
xs
jsToDoc (ForInStat each :: Bool
each i :: Ident
i e :: JExpr
e b :: JStat
b) = Text -> Doc
text Text
txt Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Text -> Doc
text "var" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i Doc -> Doc -> Doc
<+> Text -> Doc
text "in" Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
b)
where txt :: Text
txt | Bool
each = "for each"
| Bool
otherwise = "for"
jsToDoc (SwitchStat e :: JExpr
e l :: [(JExpr, JStat)]
l d :: JStat
d) = Text -> Doc
text "switch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' Doc
cases
where l' :: [Doc]
l' = ((JExpr, JStat) -> Doc) -> [(JExpr, JStat)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(c :: JExpr
c,s :: JStat
s) -> (Text -> Doc
text "case" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
c) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char ':') Doc -> Doc -> Doc
$$$ (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
s)) [(JExpr, JStat)]
l [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Text -> Doc
text "default:" Doc -> Doc -> Doc
$$$ (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
d)]
cases :: Doc
cases = [Doc] -> Doc
vcat [Doc]
l'
jsToDoc (ReturnStat e :: JExpr
e) = Text -> Doc
text "return" Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e
jsToDoc (ApplStat e :: JExpr
e es :: [JExpr]
es) = JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JExpr -> Doc) -> [JExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc [JExpr]
es)
jsToDoc (TryStat s :: JStat
s i :: Ident
i s1 :: JStat
s1 s2 :: JStat
s2) = Text -> Doc
text "try" Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
s) Doc -> Doc -> Doc
$$ Doc
mbCatch Doc -> Doc -> Doc
$$ Doc
mbFinally
where mbCatch :: Doc
mbCatch | JStat
s1 JStat -> JStat -> Bool
forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Doc
PP.empty
| Bool
otherwise = Text -> Doc
text "catch" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
s1)
mbFinally :: Doc
mbFinally | JStat
s2 JStat -> JStat -> Bool
forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Doc
PP.empty
| Bool
otherwise = Text -> Doc
text "finally" Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
s2)
jsToDoc (AssignStat i :: JExpr
i x :: JExpr
x) = JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
i Doc -> Doc -> Doc
<+> Char -> Doc
char '=' Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x
jsToDoc (PPostStat isPre :: Bool
isPre op :: [Char]
op x :: JExpr
x)
| Bool
isPre = Text -> Doc
text ([Char] -> Text
T.pack [Char]
op) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JExpr -> Doc
optParens JExpr
x
| Bool
otherwise = JExpr -> Doc
optParens JExpr
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text ([Char] -> Text
T.pack [Char]
op)
jsToDoc (AntiStat s :: [Char]
s) = Text -> Doc
text (Text -> Doc) -> ([Char] -> Text) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ "`(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ")`"
jsToDoc (ForeignStat i :: Ident
i t :: JLocalType
t) = Text -> Doc
text "//foriegn" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i Doc -> Doc -> Doc
<+> Text -> Doc
text "::" Doc -> Doc -> Doc
<+> JLocalType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JLocalType
t
jsToDoc (BlockStat xs :: [JStat]
xs) = [JStat] -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc ([JStat] -> [JStat]
flattenBlocks [JStat]
xs)
flattenBlocks :: [JStat] -> [JStat]
flattenBlocks :: [JStat] -> [JStat]
flattenBlocks (BlockStat y :: [JStat]
y:ys :: [JStat]
ys) = [JStat] -> [JStat]
flattenBlocks [JStat]
y [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat] -> [JStat]
flattenBlocks [JStat]
ys
flattenBlocks (y :: JStat
y:ys :: [JStat]
ys) = JStat
y JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat] -> [JStat]
flattenBlocks [JStat]
ys
flattenBlocks [] = []
optParens :: JExpr -> Doc
optParens :: JExpr -> Doc
optParens x :: JExpr
x = case JExpr
x of
(PPostExpr _ _ _) -> Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x)
_ -> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x
instance JsToDoc JExpr where
jsToDoc :: JExpr -> Doc
jsToDoc (ValExpr x :: JVal
x) = JVal -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JVal
x
jsToDoc (SelExpr x :: JExpr
x y :: Ident
y) = [Doc] -> Doc
cat [JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char '.', Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
y]
jsToDoc (IdxExpr x :: JExpr
x y :: JExpr
y) = JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
y)
jsToDoc (IfExpr x :: JExpr
x y :: JExpr
y z :: JExpr
z) = Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x Doc -> Doc -> Doc
<+> Char -> Doc
char '?' Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
y Doc -> Doc -> Doc
<+> Char -> Doc
char ':' Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
z)
jsToDoc (InfixExpr op :: [Char]
op x :: JExpr
x y :: JExpr
y) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep [JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x, Text -> Doc
text ([Char] -> Text
T.pack [Char]
op'), JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
y]
where op' :: [Char]
op' | [Char]
op [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== "++" = "+"
| Bool
otherwise = [Char]
op
jsToDoc (PPostExpr isPre :: Bool
isPre op :: [Char]
op x :: JExpr
x)
| Bool
isPre = Text -> Doc
text ([Char] -> Text
T.pack [Char]
op) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JExpr -> Doc
optParens JExpr
x
| Bool
otherwise = JExpr -> Doc
optParens JExpr
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text ([Char] -> Text
T.pack [Char]
op)
jsToDoc (ApplExpr je :: JExpr
je xs :: [JExpr]
xs) = JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
je Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JExpr -> Doc) -> [JExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc [JExpr]
xs)
jsToDoc (NewExpr e :: JExpr
e) = Text -> Doc
text "new" Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e
jsToDoc (AntiExpr s :: [Char]
s) = Text -> Doc
text (Text -> Doc) -> ([Char] -> Text) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ "`(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ")`"
jsToDoc (TypeExpr b :: Bool
b e :: JExpr
e t :: JLocalType
t) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e Doc -> Doc -> Doc
<+> Text -> Doc
text (if Bool
b then "/* ::!" else "/* ::") Doc -> Doc -> Doc
<+> JLocalType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JLocalType
t Doc -> Doc -> Doc
<+> Text -> Doc
text "*/"
jsToDoc (UnsatExpr e :: IdentSupply JExpr
e) = JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc (JExpr -> Doc) -> JExpr -> Doc
forall a b. (a -> b) -> a -> b
$ IdentSupply JExpr -> JExpr
forall a. IdentSupply a -> a
sat_ IdentSupply JExpr
e
instance JsToDoc JVal where
jsToDoc :: JVal -> Doc
jsToDoc (JVar i :: Ident
i) = Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i
jsToDoc (JList xs :: [JExpr]
xs) = Doc -> Doc
brackets (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JExpr -> Doc) -> [JExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc [JExpr]
xs
jsToDoc (JDouble (SaneDouble d :: Double
d)) = Double -> Doc
double Double
d
jsToDoc (JInt i :: Integer
i) = Integer -> Doc
integer Integer
i
jsToDoc (JStr s :: [Char]
s) = Text -> Doc
text (Text -> Doc) -> ([Char] -> Text) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ "\""[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char] -> [Char]
encodeJson [Char]
s[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++"\""
jsToDoc (JRegEx s :: [Char]
s) = Text -> Doc
text (Text -> Doc) -> ([Char] -> Text) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ "/"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
s[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++"/"
jsToDoc (JHash m :: Map [Char] JExpr
m)
| Map [Char] JExpr -> Bool
forall k a. Map k a -> Bool
M.null Map [Char] JExpr
m = Text -> Doc
text "{}"
| Bool
otherwise = Doc -> Doc
braceNest (Doc -> Doc)
-> ([([Char], JExpr)] -> Doc) -> [([Char], JExpr)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep ([Doc] -> Doc)
-> ([([Char], JExpr)] -> [Doc]) -> [([Char], JExpr)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([([Char], JExpr)] -> [Doc]) -> [([Char], JExpr)] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], JExpr) -> Doc) -> [([Char], JExpr)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: [Char]
x,y :: JExpr
y) -> Doc -> Doc
squotes (Text -> Doc
text ([Char] -> Text
T.pack [Char]
x)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
y) ([([Char], JExpr)] -> Doc) -> [([Char], JExpr)] -> Doc
forall a b. (a -> b) -> a -> b
$ Map [Char] JExpr -> [([Char], JExpr)]
forall k a. Map k a -> [(k, a)]
M.toList Map [Char] JExpr
m
jsToDoc (JFunc is :: [Ident]
is b :: JStat
b) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
text "function" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
fillSep ([Doc] -> Doc) -> ([Ident] -> [Doc]) -> [Ident] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Ident] -> [Doc]) -> [Ident] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ident -> Doc) -> [Ident] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc ([Ident] -> Doc) -> [Ident] -> Doc
forall a b. (a -> b) -> a -> b
$ [Ident]
is) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
b)
jsToDoc (UnsatVal f :: IdentSupply JVal
f) = JVal -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc (JVal -> Doc) -> JVal -> Doc
forall a b. (a -> b) -> a -> b
$ IdentSupply JVal -> JVal
forall a. IdentSupply a -> a
sat_ IdentSupply JVal
f
instance JsToDoc Ident where
jsToDoc :: Ident -> Doc
jsToDoc (StrI s :: [Char]
s) = Text -> Doc
text ([Char] -> Text
T.pack [Char]
s)
instance JsToDoc [JExpr] where
jsToDoc :: [JExpr] -> Doc
jsToDoc = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([JExpr] -> [Doc]) -> [JExpr] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JExpr -> Doc) -> [JExpr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi) (Doc -> Doc) -> (JExpr -> Doc) -> JExpr -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc)
instance JsToDoc [JStat] where
jsToDoc :: [JStat] -> Doc
jsToDoc = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([JStat] -> [Doc]) -> [JStat] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JStat -> Doc) -> [JStat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi) (Doc -> Doc) -> (JStat -> Doc) -> JStat -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc)
instance JsToDoc JType where
jsToDoc :: JType -> Doc
jsToDoc JTNum = Text -> Doc
text "Num"
jsToDoc JTString = Text -> Doc
text "String"
jsToDoc JTBool = Text -> Doc
text "Bool"
jsToDoc JTStat = Text -> Doc
text "()"
jsToDoc JTImpossible = Text -> Doc
text "_|_"
jsToDoc (JTForall vars :: [VarRef]
vars t :: JType
t) = Text -> Doc
text "forall" Doc -> Doc -> Doc
<+> [Doc] -> Doc
fillSep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((VarRef -> Doc) -> [VarRef] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VarRef -> Doc
forall a. Show a => (Maybe [Char], a) -> Doc
ppRef [VarRef]
vars)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text "." Doc -> Doc -> Doc
<+> JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
t
jsToDoc (JTFunc args :: [JType]
args ret :: JType
ret) = [Doc] -> Doc
fillSep ([Doc] -> Doc) -> ([JType] -> [Doc]) -> [JType] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (Text -> Doc
text " ->") ([Doc] -> [Doc]) -> ([JType] -> [Doc]) -> [JType] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JType -> Doc) -> [JType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JType -> Doc
ppType ([JType] -> Doc) -> [JType] -> Doc
forall a b. (a -> b) -> a -> b
$ [JType]
args' [JType] -> [JType] -> [JType]
forall a. [a] -> [a] -> [a]
++ [JType
ret]
where args' :: [JType]
args'
| [JType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [JType]
args = [JType
JTStat]
| Bool
otherwise = [JType]
args
jsToDoc (JTList t :: JType
t) = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
t
jsToDoc (JTMap t :: JType
t) = Text -> Doc
text "Map" Doc -> Doc -> Doc
<+> JType -> Doc
ppType JType
t
jsToDoc (JTRecord t :: JType
t mp :: Map [Char] JType
mp) = Doc -> Doc
braces ([Doc] -> Doc
fillSep ([Doc] -> Doc)
-> ([([Char], JType)] -> [Doc]) -> [([Char], JType)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc])
-> ([([Char], JType)] -> [Doc]) -> [([Char], JType)] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], JType) -> Doc) -> [([Char], JType)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(x :: [Char]
x,y :: JType
y) -> Text -> Doc
text ([Char] -> Text
T.pack [Char]
x) Doc -> Doc -> Doc
<+> Text -> Doc
text "::" Doc -> Doc -> Doc
<+> JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
y) ([([Char], JType)] -> Doc) -> [([Char], JType)] -> Doc
forall a b. (a -> b) -> a -> b
$ Map [Char] JType -> [([Char], JType)]
forall k a. Map k a -> [(k, a)]
M.toList Map [Char] JType
mp) Doc -> Doc -> Doc
<+> Text -> Doc
text "[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text "]"
jsToDoc (JTFree ref :: VarRef
ref) = VarRef -> Doc
forall a. Show a => (Maybe [Char], a) -> Doc
ppRef VarRef
ref
jsToDoc (JTRigid ref :: VarRef
ref cs :: Set Constraint
cs) = Text -> Doc
text "[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> VarRef -> Doc
forall a. Show a => (Maybe [Char], a) -> Doc
ppRef VarRef
ref Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text "]"
instance JsToDoc JLocalType where
jsToDoc :: JLocalType -> Doc
jsToDoc (cs :: [(VarRef, Constraint)]
cs,t :: JType
t) = Doc -> (Doc -> Doc) -> Maybe Doc -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Doc
text "") (Doc -> Doc -> Doc
<+> Text -> Doc
text "=> ") ([(VarRef, Constraint)] -> Maybe Doc
forall a. Show a => [((Maybe [Char], a), Constraint)] -> Maybe Doc
ppConstraintList [(VarRef, Constraint)]
cs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
t
ppConstraintList :: Show a => [((Maybe String, a), Constraint)] -> Maybe Doc
ppConstraintList :: [((Maybe [Char], a), Constraint)] -> Maybe Doc
ppConstraintList cs :: [((Maybe [Char], a), Constraint)]
cs
| [((Maybe [Char], a), Constraint)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((Maybe [Char], a), Constraint)]
cs = Maybe Doc
forall a. Maybe a
Nothing
| Bool
otherwise = Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> ([Doc] -> Doc) -> [Doc] -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> Maybe Doc) -> [Doc] -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ (((Maybe [Char], a), Constraint) -> Doc)
-> [((Maybe [Char], a), Constraint)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe [Char], a), Constraint) -> Doc
forall a. Show a => ((Maybe [Char], a), Constraint) -> Doc
go [((Maybe [Char], a), Constraint)]
cs
where
go :: ((Maybe [Char], a), Constraint) -> Doc
go (vr :: (Maybe [Char], a)
vr,Sub t' :: JType
t') = (Maybe [Char], a) -> Doc
forall a. Show a => (Maybe [Char], a) -> Doc
ppRef (Maybe [Char], a)
vr Doc -> Doc -> Doc
<+> Text -> Doc
text "<:" Doc -> Doc -> Doc
<+> JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
t'
go (vr :: (Maybe [Char], a)
vr,Super t' :: JType
t') = JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
t' Doc -> Doc -> Doc
<+> Text -> Doc
text "<:" Doc -> Doc -> Doc
<+> (Maybe [Char], a) -> Doc
forall a. Show a => (Maybe [Char], a) -> Doc
ppRef (Maybe [Char], a)
vr
ppRef :: Show a => (Maybe String, a) -> Doc
ppRef :: (Maybe [Char], a) -> Doc
ppRef (Just n :: [Char]
n,_) = Text -> Doc
text (Text -> Doc) -> ([Char] -> Text) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char]
n
ppRef (_,i :: a
i) = Text -> Doc
text (Text -> Doc) -> ([Char] -> Text) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ "t_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++a -> [Char]
forall a. Show a => a -> [Char]
show a
i
ppType :: JType -> Doc
ppType :: JType -> Doc
ppType x :: JType
x@(JTFunc _ _) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
x
ppType x :: JType
x@(JTMap _) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
x
ppType x :: JType
x = JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
x
class ToJExpr a where
toJExpr :: a -> JExpr
toJExprFromList :: [a] -> JExpr
toJExprFromList = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([a] -> JVal) -> [a] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JVal) -> ([a] -> [JExpr]) -> [a] -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> JExpr) -> [a] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr
instance ToJExpr a => ToJExpr [a] where
toJExpr :: [a] -> JExpr
toJExpr = [a] -> JExpr
forall a. ToJExpr a => [a] -> JExpr
toJExprFromList
instance ToJExpr JExpr where
toJExpr :: JExpr -> JExpr
toJExpr = JExpr -> JExpr
forall a. a -> a
id
instance ToJExpr () where
toJExpr :: () -> JExpr
toJExpr _ = JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ [JExpr] -> JVal
JList []
instance ToJExpr Bool where
toJExpr :: Bool -> JExpr
toJExpr True = [Char] -> JExpr
jsv "true"
toJExpr False = [Char] -> JExpr
jsv "false"
instance ToJExpr JVal where
toJExpr :: JVal -> JExpr
toJExpr = JVal -> JExpr
ValExpr
instance ToJExpr a => ToJExpr (M.Map String a) where
toJExpr :: Map [Char] a -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Map [Char] a -> JVal) -> Map [Char] a -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] JExpr -> JVal
JHash (Map [Char] JExpr -> JVal)
-> (Map [Char] a -> Map [Char] JExpr) -> Map [Char] a -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> JExpr) -> Map [Char] a -> Map [Char] JExpr
forall a b k. (a -> b) -> Map k a -> Map k b
M.map a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr
instance ToJExpr Double where
toJExpr :: Double -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Double -> JVal) -> Double -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SaneDouble -> JVal
JDouble (SaneDouble -> JVal) -> (Double -> SaneDouble) -> Double -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> SaneDouble
SaneDouble
instance ToJExpr Int where
toJExpr :: Int -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Int -> JVal) -> Int -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> JVal
JInt (Integer -> JVal) -> (Int -> Integer) -> Int -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToJExpr Integer where
toJExpr :: Integer -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Integer -> JVal) -> Integer -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> JVal
JInt
instance ToJExpr Char where
toJExpr :: Char -> JExpr
toJExpr = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Char -> JVal) -> Char -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> JVal
JStr ([Char] -> JVal) -> (Char -> [Char]) -> Char -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[])
toJExprFromList :: [Char] -> JExpr
toJExprFromList = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([Char] -> JVal) -> [Char] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> JVal
JStr
instance ToJExpr TS.Text where
toJExpr :: Text -> JExpr
toJExpr t :: Text
t = [Char] -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Text -> [Char]
TS.unpack Text
t)
instance ToJExpr T.Text where
toJExpr :: Text -> JExpr
toJExpr t :: Text
t = [Char] -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (Text -> [Char]
T.unpack Text
t)
instance (ToJExpr a, ToJExpr b) => ToJExpr (a,b) where
toJExpr :: (a, b) -> JExpr
toJExpr (a :: a
a,b :: b
b) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ [a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
a, b -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr b
b]
instance (ToJExpr a, ToJExpr b, ToJExpr c) => ToJExpr (a,b,c) where
toJExpr :: (a, b, c) -> JExpr
toJExpr (a :: a
a,b :: b
b,c :: c
c) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ [a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
a, b -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr b
b, c -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr c
c]
instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d) => ToJExpr (a,b,c,d) where
toJExpr :: (a, b, c, d) -> JExpr
toJExpr (a :: a
a,b :: b
b,c :: c
c,d :: d
d) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ [a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
a, b -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr b
b, c -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr c
c, d -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr d
d]
instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d, ToJExpr e) => ToJExpr (a,b,c,d,e) where
toJExpr :: (a, b, c, d, e) -> JExpr
toJExpr (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ [a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
a, b -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr b
b, c -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr c
c, d -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr d
d, e -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr e
e]
instance (ToJExpr a, ToJExpr b, ToJExpr c, ToJExpr d, ToJExpr e, ToJExpr f) => ToJExpr (a,b,c,d,e,f) where
toJExpr :: (a, b, c, d, e, f) -> JExpr
toJExpr (a :: a
a,b :: b
b,c :: c
c,d :: d
d,e :: e
e,f :: f
f) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([JExpr] -> JVal) -> [JExpr] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList ([JExpr] -> JExpr) -> [JExpr] -> JExpr
forall a b. (a -> b) -> a -> b
$ [a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
a, b -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr b
b, c -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr c
c, d -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr d
d, e -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr e
e, f -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr f
f]
instance Num JExpr where
fromInteger :: Integer -> JExpr
fromInteger = JVal -> JExpr
ValExpr (JVal -> JExpr) -> (Integer -> JVal) -> Integer -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> JVal
JInt (Integer -> JVal) -> (Integer -> Integer) -> Integer -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
x :: JExpr
x + :: JExpr -> JExpr -> JExpr
+ y :: JExpr
y = [Char] -> JExpr -> JExpr -> JExpr
InfixExpr "+" JExpr
x JExpr
y
x :: JExpr
x - :: JExpr -> JExpr -> JExpr
- y :: JExpr
y = [Char] -> JExpr -> JExpr -> JExpr
InfixExpr "-" JExpr
x JExpr
y
x :: JExpr
x * :: JExpr -> JExpr -> JExpr
* y :: JExpr
y = [Char] -> JExpr -> JExpr -> JExpr
InfixExpr "*" JExpr
x JExpr
y
abs :: JExpr -> JExpr
abs x :: JExpr
x = JExpr -> [JExpr] -> JExpr
ApplExpr ([Char] -> JExpr
jsv "Math.abs") [JExpr
x]
signum :: JExpr -> JExpr
signum x :: JExpr
x = JExpr -> JExpr -> JExpr -> JExpr
IfExpr ([Char] -> JExpr -> JExpr -> JExpr
InfixExpr ">" JExpr
x 0) 1 (JExpr -> JExpr -> JExpr -> JExpr
IfExpr ([Char] -> JExpr -> JExpr -> JExpr
InfixExpr "==" JExpr
x 0) 0 (-1))
class ToStat a where
toStat :: a -> JStat
instance ToStat JStat where
toStat :: JStat -> JStat
toStat = JStat -> JStat
forall a. a -> a
id
instance ToStat [JStat] where
toStat :: [JStat] -> JStat
toStat = [JStat] -> JStat
BlockStat
instance ToStat JExpr where
toStat :: JExpr -> JStat
toStat = JExpr -> JStat
expr2stat
instance ToStat [JExpr] where
toStat :: [JExpr] -> JStat
toStat = [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> ([JExpr] -> [JStat]) -> [JExpr] -> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JExpr -> JStat) -> [JExpr] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map JExpr -> JStat
expr2stat
jLam :: (ToSat a) => a -> JExpr
jLam :: a -> JExpr
jLam f :: a
f = JVal -> JExpr
ValExpr (JVal -> JExpr)
-> (StateT [Ident] Identity JVal -> JVal)
-> StateT [Ident] Identity JVal
-> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentSupply JVal -> JVal
UnsatVal (IdentSupply JVal -> JVal)
-> (StateT [Ident] Identity JVal -> IdentSupply JVal)
-> StateT [Ident] Identity JVal
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT [Ident] Identity JVal -> IdentSupply JVal
forall a. State [Ident] a -> IdentSupply a
IS (StateT [Ident] Identity JVal -> JExpr)
-> StateT [Ident] Identity JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ do
(block :: JStat
block,is :: [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ a -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
JVal -> StateT [Ident] Identity JVal
forall (m :: * -> *) a. Monad m => a -> m a
return (JVal -> StateT [Ident] Identity JVal)
-> JVal -> StateT [Ident] Identity JVal
forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
is JStat
block
jVar :: (ToSat a) => a -> JStat
jVar :: a -> JStat
jVar f :: a
f = IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat)
-> (StateT [Ident] Identity JStat -> IdentSupply JStat)
-> StateT [Ident] Identity JStat
-> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT [Ident] Identity JStat -> IdentSupply JStat
forall a. State [Ident] a -> IdentSupply a
IS (StateT [Ident] Identity JStat -> JStat)
-> StateT [Ident] Identity JStat -> JStat
forall a b. (a -> b) -> a -> b
$ do
(block :: JStat
block, is :: [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ a -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
let addDecls :: JStat -> JStat
addDecls (BlockStat ss :: [JStat]
ss) =
[JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ (Ident -> JStat) -> [Ident] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Ident
x -> Ident -> Maybe JLocalType -> JStat
DeclStat Ident
x Maybe JLocalType
forall a. Maybe a
Nothing) [Ident]
is [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat]
ss
addDecls x :: JStat
x = JStat
x
JStat -> StateT [Ident] Identity JStat
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> StateT [Ident] Identity JStat)
-> JStat -> StateT [Ident] Identity JStat
forall a b. (a -> b) -> a -> b
$ JStat -> JStat
addDecls JStat
block
jVarTy :: (ToSat a) => a -> (Maybe JLocalType) -> JStat
jVarTy :: a -> Maybe JLocalType -> JStat
jVarTy f :: a
f t :: Maybe JLocalType
t = IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat)
-> (StateT [Ident] Identity JStat -> IdentSupply JStat)
-> StateT [Ident] Identity JStat
-> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT [Ident] Identity JStat -> IdentSupply JStat
forall a. State [Ident] a -> IdentSupply a
IS (StateT [Ident] Identity JStat -> JStat)
-> StateT [Ident] Identity JStat -> JStat
forall a b. (a -> b) -> a -> b
$ do
(block :: JStat
block, is :: [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ a -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
let addDecls :: JStat -> JStat
addDecls (BlockStat ss :: [JStat]
ss) =
[JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ (Ident -> JStat) -> [Ident] -> [JStat]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Ident
x -> Ident -> Maybe JLocalType -> JStat
DeclStat Ident
x Maybe JLocalType
t) [Ident]
is [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat]
ss
addDecls x :: JStat
x = JStat
x
JStat -> StateT [Ident] Identity JStat
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> StateT [Ident] Identity JStat)
-> JStat -> StateT [Ident] Identity JStat
forall a b. (a -> b) -> a -> b
$ JStat -> JStat
addDecls JStat
block
jForIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
jForIn :: JExpr -> (JExpr -> a) -> JStat
jForIn e :: JExpr
e f :: JExpr -> a
f = IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat)
-> (StateT [Ident] Identity JStat -> IdentSupply JStat)
-> StateT [Ident] Identity JStat
-> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT [Ident] Identity JStat -> IdentSupply JStat
forall a. State [Ident] a -> IdentSupply a
IS (StateT [Ident] Identity JStat -> JStat)
-> StateT [Ident] Identity JStat -> JStat
forall a b. (a -> b) -> a -> b
$ do
(block :: JStat
block, is :: [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JExpr -> a) -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JExpr -> a
f []
JStat -> StateT [Ident] Identity JStat
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> StateT [Ident] Identity JStat)
-> JStat -> StateT [Ident] Identity JStat
forall a b. (a -> b) -> a -> b
$ Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
False ([Char] -> [Ident] -> Ident
forall a. HasCallStack => [Char] -> [a] -> a
headNote "jForIn" [Ident]
is) JExpr
e JStat
block
jForEachIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
jForEachIn :: JExpr -> (JExpr -> a) -> JStat
jForEachIn e :: JExpr
e f :: JExpr -> a
f = IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat)
-> (StateT [Ident] Identity JStat -> IdentSupply JStat)
-> StateT [Ident] Identity JStat
-> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT [Ident] Identity JStat -> IdentSupply JStat
forall a. State [Ident] a -> IdentSupply a
IS (StateT [Ident] Identity JStat -> JStat)
-> StateT [Ident] Identity JStat -> JStat
forall a b. (a -> b) -> a -> b
$ do
(block :: JStat
block, is :: [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ (JExpr -> a) -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JExpr -> a
f []
JStat -> StateT [Ident] Identity JStat
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> StateT [Ident] Identity JStat)
-> JStat -> StateT [Ident] Identity JStat
forall a b. (a -> b) -> a -> b
$ Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
True ([Char] -> [Ident] -> Ident
forall a. HasCallStack => [Char] -> [a] -> a
headNote "jForIn" [Ident]
is) JExpr
e JStat
block
jTryCatchFinally :: (ToSat a) => JStat -> a -> JStat -> JStat
jTryCatchFinally :: JStat -> a -> JStat -> JStat
jTryCatchFinally s :: JStat
s f :: a
f s2 :: JStat
s2 = IdentSupply JStat -> JStat
UnsatBlock (IdentSupply JStat -> JStat)
-> (StateT [Ident] Identity JStat -> IdentSupply JStat)
-> StateT [Ident] Identity JStat
-> JStat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT [Ident] Identity JStat -> IdentSupply JStat
forall a. State [Ident] a -> IdentSupply a
IS (StateT [Ident] Identity JStat -> JStat)
-> StateT [Ident] Identity JStat -> JStat
forall a b. (a -> b) -> a -> b
$ do
(block :: JStat
block, is :: [Ident]
is) <- IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a. IdentSupply a -> State [Ident] a
runIdentSupply (IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident]))
-> IdentSupply (JStat, [Ident]) -> State [Ident] (JStat, [Ident])
forall a b. (a -> b) -> a -> b
$ a -> [Ident] -> IdentSupply (JStat, [Ident])
forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
JStat -> StateT [Ident] Identity JStat
forall (m :: * -> *) a. Monad m => a -> m a
return (JStat -> StateT [Ident] Identity JStat)
-> JStat -> StateT [Ident] Identity JStat
forall a b. (a -> b) -> a -> b
$ JStat -> Ident -> JStat -> JStat -> JStat
TryStat JStat
s ([Char] -> [Ident] -> Ident
forall a. HasCallStack => [Char] -> [a] -> a
headNote "jTryCatch" [Ident]
is) JStat
block JStat
s2
jsv :: String -> JExpr
jsv :: [Char] -> JExpr
jsv = JVal -> JExpr
ValExpr (JVal -> JExpr) -> ([Char] -> JVal) -> [Char] -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> JVal
JVar (Ident -> JVal) -> ([Char] -> Ident) -> [Char] -> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Ident
StrI
jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat
jFor :: JStat -> a -> JStat -> b -> JStat
jFor before :: JStat
before p :: a
p after :: JStat
after b :: b
b = [JStat] -> JStat
BlockStat [JStat
before, Bool -> JExpr -> JStat -> JStat
WhileStat Bool
False (a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
p) JStat
b']
where b' :: JStat
b' = case b -> JStat
forall a. ToStat a => a -> JStat
toStat b
b of
BlockStat xs :: [JStat]
xs -> [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
after]
x :: JStat
x -> [JStat] -> JStat
BlockStat [JStat
x,JStat
after]
jhEmpty :: M.Map String JExpr
jhEmpty :: Map [Char] JExpr
jhEmpty = Map [Char] JExpr
forall k a. Map k a
M.empty
jhSingle :: ToJExpr a => String -> a -> M.Map String JExpr
jhSingle :: [Char] -> a -> Map [Char] JExpr
jhSingle k :: [Char]
k v :: a
v = [Char] -> a -> Map [Char] JExpr -> Map [Char] JExpr
forall a.
ToJExpr a =>
[Char] -> a -> Map [Char] JExpr -> Map [Char] JExpr
jhAdd [Char]
k a
v (Map [Char] JExpr -> Map [Char] JExpr)
-> Map [Char] JExpr -> Map [Char] JExpr
forall a b. (a -> b) -> a -> b
$ Map [Char] JExpr
jhEmpty
jhAdd :: ToJExpr a => String -> a -> M.Map String JExpr -> M.Map String JExpr
jhAdd :: [Char] -> a -> Map [Char] JExpr -> Map [Char] JExpr
jhAdd k :: [Char]
k v :: a
v m :: Map [Char] JExpr
m = [Char] -> JExpr -> Map [Char] JExpr -> Map [Char] JExpr
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert [Char]
k (a -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr a
v) Map [Char] JExpr
m
jhFromList :: [(String, JExpr)] -> JVal
jhFromList :: [([Char], JExpr)] -> JVal
jhFromList = Map [Char] JExpr -> JVal
JHash (Map [Char] JExpr -> JVal)
-> ([([Char], JExpr)] -> Map [Char] JExpr)
-> [([Char], JExpr)]
-> JVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Char], JExpr)] -> Map [Char] JExpr
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
jtFromList :: JType -> [(String, JType)] -> JType
jtFromList :: JType -> [([Char], JType)] -> JType
jtFromList t :: JType
t y :: [([Char], JType)]
y = JType -> Map [Char] JType -> JType
JTRecord JType
t (Map [Char] JType -> JType) -> Map [Char] JType -> JType
forall a b. (a -> b) -> a -> b
$ [([Char], JType)] -> Map [Char] JType
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [([Char], JType)]
y
nullStat :: JStat
nullStat :: JStat
nullStat = [JStat] -> JStat
BlockStat []
instance ToJExpr Value where
toJExpr :: Value -> JExpr
toJExpr Null = JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar (Ident -> JVal) -> Ident -> JVal
forall a b. (a -> b) -> a -> b
$ [Char] -> Ident
StrI "null"
toJExpr (Bool b :: Bool
b) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar (Ident -> JVal) -> Ident -> JVal
forall a b. (a -> b) -> a -> b
$ [Char] -> Ident
StrI ([Char] -> Ident) -> [Char] -> Ident
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
b)
toJExpr (Number n :: Scientific
n) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ SaneDouble -> JVal
JDouble (SaneDouble -> JVal) -> SaneDouble -> JVal
forall a b. (a -> b) -> a -> b
$ Scientific -> SaneDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
n
toJExpr (String s :: Text
s) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ [Char] -> JVal
JStr ([Char] -> JVal) -> [Char] -> JVal
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
TS.unpack Text
s
toJExpr (Array vs :: Array
vs) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ [JExpr] -> JVal
JList ([JExpr] -> JVal) -> [JExpr] -> JVal
forall a b. (a -> b) -> a -> b
$ (Value -> JExpr) -> [Value] -> [JExpr]
forall a b. (a -> b) -> [a] -> [b]
map Value -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr ([Value] -> [JExpr]) -> [Value] -> [JExpr]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
vs
toJExpr (Object obj :: Object
obj) = JVal -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Map [Char] JExpr -> JVal
JHash (Map [Char] JExpr -> JVal) -> Map [Char] JExpr -> JVal
forall a b. (a -> b) -> a -> b
$ [([Char], JExpr)] -> Map [Char] JExpr
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Char], JExpr)] -> Map [Char] JExpr)
-> [([Char], JExpr)] -> Map [Char] JExpr
forall a b. (a -> b) -> a -> b
$ ((Text, Value) -> ([Char], JExpr))
-> [(Text, Value)] -> [([Char], JExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
TS.unpack (Text -> [Char])
-> (Value -> JExpr) -> (Text, Value) -> ([Char], JExpr)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Value -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr) ([(Text, Value)] -> [([Char], JExpr)])
-> [(Text, Value)] -> [([Char], JExpr)]
forall a b. (a -> b) -> a -> b
$ Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
obj
encodeJson :: String -> String
encodeJson :: [Char] -> [Char]
encodeJson = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
encodeJsonChar
encodeJsonChar :: Char -> String
encodeJsonChar :: Char -> [Char]
encodeJsonChar '/' = "\\/"
encodeJsonChar '\b' = "\\b"
encodeJsonChar '\f' = "\\f"
encodeJsonChar '\n' = "\\n"
encodeJsonChar '\r' = "\\r"
encodeJsonChar '\t' = "\\t"
encodeJsonChar '"' = "\\\""
encodeJsonChar '\\' = "\\\\"
encodeJsonChar c :: Char
c
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isControl Char
c = [Char
c]
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< '\x10' = '\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: 'u' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: '0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: '0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: '0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
hexxs
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< '\x100' = '\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: 'u' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: '0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: '0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
hexxs
| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< '\x1000' = '\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: 'u' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: '0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
hexxs
where hexxs :: [Char]
hexxs = Int -> [Char] -> [Char]
forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) ""
encodeJsonChar c :: Char
c = [Char
c]