{-# LANGUAGE CPP, FlexibleInstances, UndecidableInstances, OverlappingInstances, OverloadedStrings, TypeFamilies, RankNTypes, DeriveDataTypeable, StandaloneDeriving, FlexibleContexts, TypeSynonymInstances, ScopedTypeVariables, GADTs
           , GeneralizedNewtypeDeriving, LambdaCase #-}

-----------------------------------------------------------------------------
{- |
Module      :  Language.Javascript.JMacro.Base
Copyright   :  (c) Gershom Bazerman, 2009
License     :  BSD 3 Clause
Maintainer  :  gershomb@gmail.com
Stability   :  experimental

Simple DSL for lightweight (untyped) programmatic generation of Javascript.
-}
-----------------------------------------------------------------------------

module Language.Javascript.JMacro.Base (
  -- * ADT
  JStat(..), JExpr(..), JVal(..), Ident(..), IdentSupply(..), JsLabel,
  -- * Generic traversal (via compos)
  JMacro(..), JMGadt(..), Compos(..),
  composOp, composOpM, composOpM_, composOpFold,
  -- * Hygienic transformation
  withHygiene, scopify,
  -- * Display/Output
  renderJs, renderPrefixJs, JsToDoc(..),
  -- * Ad-hoc data marshalling
  ToJExpr(..),
  -- * Literals
  jsv,
  -- * Occasionally helpful combinators
  jLam, jVar, jVarTy, jFor, jForIn, jForEachIn, jTryCatchFinally,
  expr2stat, ToStat(..), nullStat,
  -- * Hash combinators
  jhEmpty, jhSingle, jhAdd, jhFromList,
  -- * Utility
  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
#if MIN_VERSION_aeson (2,0,0)
import qualified Data.Aeson.Key    as KM
import qualified Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as HM
#endif
import Text.PrettyPrint.Leijen.Text hiding ((<$>))

import qualified Text.PrettyPrint.Leijen.Text as PP

import Language.Javascript.JMacro.Types

-- wl-pprint-text compatibility with pretty
infixl 5 $$, $+$
($+$), ($$), ($$$) :: Doc -> Doc -> Doc
Doc
x $+$ :: Doc -> Doc -> Doc
$+$ Doc
y = Doc
x Doc -> Doc -> Doc
PP.<$> Doc
y
Doc
x $$ :: Doc -> Doc -> Doc
$$ Doc
y  = Doc -> Doc
align (Doc
x Doc -> Doc -> Doc
$+$ Doc
y)
Doc
x $$$ :: Doc -> Doc -> Doc
$$$ Doc
y = Doc -> Doc
align (Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
x Doc -> Doc -> Doc
$+$ Doc
y)

{--------------------------------------------------------------------
  ADTs
--------------------------------------------------------------------}

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 State [Ident] a -> State [Ident] b
f IdentSupply a
x = State [Ident] b -> IdentSupply b
forall a. State [Ident] a -> IdentSupply a
IS (State [Ident] b -> IdentSupply b)
-> State [Ident] b -> IdentSupply b
forall a b. (a -> b) -> a -> b
$ State [Ident] a -> State [Ident] b
f (IdentSupply a -> State [Ident] a
forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply a
x)

instance 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 forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ Constr
_ = [Char] -> c (IdentSupply a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold IdentSupply"
    toConstr :: IdentSupply a -> Constr
toConstr IdentSupply a
_ = [Char] -> Constr
forall a. HasCallStack => [Char] -> a
error [Char]
"toConstr IdentSupply"
    dataTypeOf :: IdentSupply a -> DataType
dataTypeOf IdentSupply a
_ = [Char] -> DataType
mkNoRepType [Char]
"IdentSupply"

instance Functor IdentSupply where
    fmap :: (a -> b) -> IdentSupply a -> IdentSupply b
fmap a -> b
f IdentSupply a
x = (State [Ident] a -> State [Ident] b)
-> IdentSupply a -> IdentSupply b
forall a b.
(State [Ident] a -> State [Ident] b)
-> IdentSupply a -> IdentSupply b
inIdentSupply ((a -> b) -> State [Ident] a -> State [Ident] b
forall (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
            (Ident
x:[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
            [Ident]
_ -> [Char] -> State [Ident] Ident
forall a. HasCallStack => [Char] -> a
error [Char]
"not enough elements"

newIdentSupply :: Maybe String -> [Ident]
newIdentSupply :: Maybe [Char] -> [Ident]
newIdentSupply Maybe [Char]
Nothing     = Maybe [Char] -> [Ident]
newIdentSupply ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"jmId")
newIdentSupply (Just [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 <- [(Integer
0::Integer)..]]
    where pfx :: [Char]
pfx = [Char]
pfx'[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char
'_']

sat_ :: IdentSupply a -> a
sat_ :: IdentSupply a -> a
sat_ 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 [Char]
"<<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 IdentSupply a
x = [Char]
"(" [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]
++ [Char]
")"


--switch
--Yield statement?
--destructuring/pattern matching functions --pattern matching in lambdas.
--array comprehensions/generators?
--add postfix stat

-- | Statements
data JStat = DeclStat   Ident (Maybe JLocalType)
           | ReturnStat JExpr
           | IfStat     JExpr JStat JStat
           | WhileStat  Bool JExpr JStat -- bool is "do"
           | ForInStat  Bool Ident JExpr JStat -- bool is "each"
           | 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 [JStat]
xs) (BlockStat [JStat]
ys) = [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat]
xs [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat]
ys
    (<>) (BlockStat [JStat]
xs) JStat
ys = [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ [JStat]
xs [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat
ys]
    (<>) JStat
xs (BlockStat [JStat]
ys) = [JStat] -> JStat
BlockStat ([JStat] -> JStat) -> [JStat] -> JStat
forall a b. (a -> b) -> a -> b
$ JStat
xs JStat -> [JStat] -> [JStat]
forall a. a -> [a] -> [a]
: [JStat]
ys
    (<>) JStat
xs JStat
ys = [JStat] -> JStat
BlockStat [JStat
xs,JStat
ys]


instance Monoid JStat where
    mempty :: JStat
mempty = [JStat] -> JStat
BlockStat []
    mappend :: JStat -> JStat -> JStat
mappend JStat
x JStat
y = JStat
x JStat -> JStat -> JStat
forall a. Semigroup a => a -> a -> a
<> JStat
y


-- TODO: annotate expressions with type
-- | Expressions
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)

-- | Values
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 Double
x) == :: SaneDouble -> SaneDouble -> Bool
== (SaneDouble Double
y) = Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y Bool -> Bool -> Bool
|| (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> Bool
&& Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
y)

instance Ord SaneDouble where
    compare :: SaneDouble -> SaneDouble -> Ordering
compare (SaneDouble Double
x) (SaneDouble Double
y) = Maybe Double -> Maybe Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Double -> Maybe Double
forall a. RealFloat a => a -> Maybe a
fromNaN Double
x) (Double -> Maybe Double
forall a. RealFloat a => a -> Maybe a
fromNaN Double
y)
        where fromNaN :: a -> Maybe a
fromNaN a
z | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
z = Maybe a
forall a. Maybe a
Nothing
                        | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
z

instance Show SaneDouble where
    show :: SaneDouble -> [Char]
show (SaneDouble Double
x) = Double -> [Char]
forall a. Show a => a -> [Char]
show Double
x

-- | Identifiers
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)


--deriving instance Typeable2 (StateT [Ident] Identity)
--deriving instance Data (State [Ident] JVal)
--deriving instance Data (State [Ident] JExpr)
--deriving instance Data (State [Ident] JStat)



expr2stat :: JExpr -> JStat
expr2stat :: JExpr -> JStat
expr2stat (ApplExpr JExpr
x [JExpr]
y) = (JExpr -> [JExpr] -> JStat
ApplStat JExpr
x [JExpr]
y)
expr2stat (IfExpr JExpr
x JExpr
y JExpr
z) = JExpr -> JStat -> JStat -> JStat
IfStat JExpr
x (JExpr -> JStat
expr2stat JExpr
y) (JExpr -> JStat
expr2stat JExpr
z)
expr2stat (PPostExpr Bool
b [Char]
s JExpr
x) = Bool -> [Char] -> JExpr -> JStat
PPostStat Bool
b [Char]
s JExpr
x
expr2stat (AntiExpr [Char]
x) = [Char] -> JStat
AntiStat [Char]
x
expr2stat JExpr
_ = JStat
nullStat


{--------------------------------------------------------------------
  Compos
--------------------------------------------------------------------}
-- | Compos and ops for generic traversal as defined over
-- the JMacro ADT.

-- | Utility class to coerce the ADT into a regular structure.
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 Ident
x) = Ident
x
    jfromGADT JMGadt Ident
_ = [Char] -> Ident
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

instance JMacro JStat where
    jtoGADT :: JStat -> JMGadt JStat
jtoGADT = JStat -> JMGadt JStat
JMGStat
    jfromGADT :: JMGadt JStat -> JStat
jfromGADT (JMGStat JStat
x) = JStat
x
    jfromGADT JMGadt JStat
_ = [Char] -> JStat
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

instance JMacro JExpr where
    jtoGADT :: JExpr -> JMGadt JExpr
jtoGADT = JExpr -> JMGadt JExpr
JMGExpr
    jfromGADT :: JMGadt JExpr -> JExpr
jfromGADT (JMGExpr JExpr
x) = JExpr
x
    jfromGADT JMGadt JExpr
_ = [Char] -> JExpr
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

instance JMacro JVal where
    jtoGADT :: JVal -> JMGadt JVal
jtoGADT = JVal -> JMGadt JVal
JMGVal
    jfromGADT :: JMGadt JVal -> JVal
jfromGADT (JMGVal JVal
x) = JVal
x
    jfromGADT JMGadt JVal
_ = [Char] -> JVal
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"

-- | Union type to allow regular traversal by compos.
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 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 b
z b -> b -> b
c 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 (\a
_ -> 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 forall a. a -> m a
ret forall a b. m (a -> b) -> m a -> m b
app forall a. JMGadt a -> m (JMGadt a)
f' JMGadt c
v =
    case JMGadt c
v of
     JMGId Ident
_ -> JMGadt c -> m (JMGadt c)
forall a. a -> m a
ret JMGadt c
v
     JMGStat 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 Ident
i 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 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 JExpr
e JStat
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 Bool
b JExpr
e 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 Bool
b Ident
i JExpr
e 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 JExpr
e [(JExpr, JStat)]
l 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' (\(JExpr
c,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 [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  JExpr
e [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 JStat
s Ident
i JStat
s1 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 Bool
b [Char]
o 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 JExpr
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 IdentSupply JStat
_ -> JStat -> m JStat
forall a. a -> m a
ret JStat
v'
           AntiStat [Char]
_ -> JStat -> m JStat
forall a. a -> m a
ret JStat
v'
           ForeignStat Ident
i 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 Maybe [Char]
l -> JStat -> m JStat
forall a. a -> m a
ret (Maybe [Char] -> JStat
ContinueStat Maybe [Char]
l)
           BreakStat Maybe [Char]
l -> JStat -> m JStat
forall a. a -> m a
ret (Maybe [Char] -> JStat
BreakStat Maybe [Char]
l)
           LabelStat [Char]
l 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 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 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 JExpr
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 JExpr
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 [Char]
o JExpr
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 Bool
b [Char]
o 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 JExpr
e JExpr
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 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 JExpr
e [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 [Char]
_ -> JExpr -> m JExpr
forall a. a -> m a
ret JExpr
v'
           TypeExpr Bool
b JExpr
e 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 IdentSupply JExpr
_ -> JExpr -> m JExpr
forall a. a -> m a
ret JExpr
v'
     JMGVal 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 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 [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 SaneDouble
_ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
           JInt    Integer
_ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
           JStr    [Char]
_ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
           JRegEx  [Char]
_ -> JVal -> m JVal
forall a. a -> m a
ret JVal
v'
           JHash   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 ([[Char]]
ls, [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 [Ident]
xs 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 IdentSupply JVal
_ -> 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' 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 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)

{--------------------------------------------------------------------
  New Identifiers
--------------------------------------------------------------------}

class ToSat a where
    toSat_ :: a -> [Ident] -> IdentSupply (JStat, [Ident])

instance ToSat [JStat] where
    toSat_ :: [JStat] -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ [JStat]
f [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_ JStat
f [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_ JExpr
f [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_ [JExpr]
f [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_ b -> a
f [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 -> JExpr
ValExpr (JVal -> JExpr) -> JVal -> JExpr
forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
x)) (Ident
xIdent -> [Ident] -> [Ident]
forall a. a -> [a] -> [a]
:[Ident]
vs)

{-
splitIdentSupply :: ([Ident] -> ([Ident], [Ident]))
splitIdentSupply is = (takeAlt is, takeAlt (drop 1 is))
    where takeAlt (x:_:xs) = x : takeAlt xs
          takeAlt _ = error "splitIdentSupply: stream is not infinite"
-}

{--------------------------------------------------------------------
  Saturation
--------------------------------------------------------------------}

-- | Given an optional prefix, fills in all free variable names with a supply
-- of names generated by the prefix.
jsSaturate :: (JMacro a) => Maybe String -> a -> a
jsSaturate :: Maybe [Char] -> a -> a
jsSaturate Maybe [Char]
str 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_ 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 JMGadt a
v = case JMGadt a
v of
               JMGStat (UnsatBlock 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  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   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)
               JMGadt a
_ -> (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

{--------------------------------------------------------------------
  Transformation
--------------------------------------------------------------------}

--doesn't apply to unsaturated bits
jsReplace_ :: JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ :: [(Ident, Ident)] -> a -> a
jsReplace_ [(Ident, Ident)]
xs 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 JMGadt a
v = case JMGadt a
v of
                   JMGId 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)
                   JMGadt a
_ -> (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

--only works on fully saturated things
jsUnsat_ :: JMacro a => [Ident] -> a -> IdentSupply a
jsUnsat_ :: [Ident] -> a -> IdentSupply a
jsUnsat_ [Ident]
xs 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
  ([Ident]
idents,[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

-- | Apply a transformation to a fully saturated syntax tree,
-- taking care to return any free variables back to their free state
-- following the transformation. As the transformation preserves
-- free variables, it is hygienic.
withHygiene ::  JMacro a => (a -> a) -> a -> a
withHygiene :: (a -> a) -> a -> a
withHygiene a -> a
f 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 JExpr
z -> JExpr -> JMGadt JExpr
JMGExpr (JExpr -> JMGadt JExpr) -> JExpr -> JMGadt JExpr
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 JStat
z -> JStat -> JMGadt JStat
JMGStat (JStat -> JMGadt JStat) -> JStat -> JMGadt JStat
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  JVal
z -> JVal -> JMGadt JVal
JMGVal (JVal -> JMGadt JVal) -> JVal -> JMGadt JVal
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 Ident
_ -> 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 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 Int
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 [Char]
a], [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
              ([Ident], [Ident])
_ -> [Char] -> State [Ident] a
forall a. HasCallStack => [Char] -> a
error [Char]
"Not as string"

withHygiene_ :: JMacro a => String -> (a -> a) -> a -> a
withHygiene_ :: [Char] -> (a -> a) -> a -> a
withHygiene_ [Char]
un a -> a
f 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
_ -> JStat -> JMGadt JStat
forall a. JMacro a => a -> JMGadt a
jtoGADT (JStat -> JMGadt JStat) -> JStat -> JMGadt JStat
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
_ -> JExpr -> JMGadt JExpr
forall a. JMacro a => a -> JMGadt a
jtoGADT (JExpr -> JMGadt JExpr) -> JExpr -> JMGadt JExpr
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
_ -> JVal -> JMGadt JVal
forall a. JMacro a => a -> JMGadt a
jtoGADT (JVal -> JMGadt JVal) -> JVal -> JMGadt JVal
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 Ident
_ -> 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
        (a
x', (StrI [Char]
l : [Ident]
_)) = 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 ([Char]
"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] -> [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 ([Char]
"inSat" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
un)

-- | Takes a fully saturated expression and transforms it to use unique variables that respect scope.
scopify :: JStat -> JStat
scopify :: JStat -> JStat
scopify 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 JMGadt a
v = case JMGadt a
v of
                   (JMGStat (BlockStat [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 [Char]
i) Maybe JLocalType
t : [JStat]
xs) =  case [Char]
i of
                                (Char
'!':Char
'!':[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
                                (Char
'!':[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
                                [Char]
_ -> 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
                                     (Ident
newI:[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)]
                                     [Ident]
_ -> [Char] -> StateT [Ident] Identity [JStat]
forall a. HasCallStack => [Char] -> a
error [Char]
"scopify"
                             blocks (JStat
x':[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 Bool
b (StrI [Char]
i) JExpr
e 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
                          (Ident
newI:[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
                          [Ident]
_ -> [Char] -> State [Ident] (JMGadt JStat)
forall a. HasCallStack => [Char] -> a
error [Char]
"scopify2"
                   (JMGStat (TryStat JStat
s (StrI [Char]
i) JStat
s1 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
                          (Ident
newI:[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
                          [Ident]
_ -> [Char] -> State [Ident] (JMGadt JStat)
forall a. HasCallStack => [Char] -> a
error [Char]
"scopify3"
                   (JMGExpr (ValExpr (JFunc [Ident]
is JStat
s))) -> do
                            [Ident]
st <- StateT [Ident] Identity [Ident]
forall s (m :: * -> *). MonadState s m => m s
get
                            let ([Ident]
newIs,[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 JExpr))
-> JVal -> State [Ident] (JMGadt JExpr)
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
                   JMGadt a
_ -> (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

{--------------------------------------------------------------------
  Pretty Printing
--------------------------------------------------------------------}

-- | Render a syntax tree as a pretty-printable document
-- (simply showing the resultant doc produces a nice,
-- well formatted String).
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

-- | Render a syntax tree as a pretty-printable document, using a given prefix to all generated names. Use this with distinct prefixes to ensure distinct generated names between independent calls to render(Prefix)Js.
renderPrefixJs :: (JsToDoc a, JMacro a) => String -> a -> Doc
renderPrefixJs :: [Char] -> a -> Doc
renderPrefixJs [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
$ [Char]
"jmId_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
pfx)

braceNest :: Doc -> Doc
braceNest :: Doc -> Doc
braceNest Doc
x = Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest Int
2 Doc
x Doc -> Doc -> Doc
$$ Char -> Doc
char Char
'}'

braceNest' :: Doc -> Doc
braceNest' :: Doc -> Doc
braceNest' Doc
x = Int -> Doc -> Doc
nest Int
2 (Char -> Doc
char Char
'{' Doc -> Doc -> Doc
$+$ Doc
x) Doc -> Doc -> Doc
$$ Char -> Doc
char Char
'}'

class JsToDoc a
    where jsToDoc :: a -> Doc

instance JsToDoc JStat where
    jsToDoc :: JStat -> Doc
jsToDoc (IfStat JExpr
cond JStat
x JStat
y) = Text -> Doc
text 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 Text
"else" Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
y)
    jsToDoc (DeclStat Ident
x Maybe JLocalType
t) = Text -> Doc
text 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
                       Maybe JLocalType
Nothing -> Text -> Doc
text Text
""
                       Just JLocalType
tp -> Text -> Doc
text Text
" /* ::" Doc -> Doc -> Doc
<+> JLocalType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JLocalType
tp Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"*/"
    jsToDoc (WhileStat Bool
False JExpr
p JStat
b)  = Text -> Doc
text 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 Bool
True  JExpr
p JStat
b)  = (Text -> Doc
text 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 Text
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
p)
    jsToDoc (UnsatBlock 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 Maybe [Char]
l) = Doc -> ([Char] -> Doc) -> Maybe [Char] -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Doc
text 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) 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 Maybe [Char]
l) = Doc -> ([Char] -> Doc) -> Maybe [Char] -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Doc
text 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) 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 [Char]
l JStat
s) = Text -> Doc
text ([Char] -> Text
T.pack [Char]
l) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
':' Doc -> Doc -> Doc
$$ JStat -> Doc
printBS JStat
s
        where
          printBS :: JStat -> Doc
printBS (BlockStat [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 JStat
x = JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
x
          interSemi :: [a] -> [Doc]
interSemi [a
x] = [a -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc a
x]
          interSemi [] = []
          interSemi (a
x:[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 Bool
each Ident
i JExpr
e JStat
b) = Text -> Doc
text Text
txt Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Text -> Doc
text Text
"var" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i Doc -> Doc -> Doc
<+> Text -> Doc
text 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 = Text
"for each"
                  | Bool
otherwise = Text
"for"
    jsToDoc (SwitchStat JExpr
e [(JExpr, JStat)]
l JStat
d) = Text -> Doc
text 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 (\(JExpr
c,JStat
s) -> (Text -> Doc
text 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 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 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 JExpr
e) = Text -> Doc
text Text
"return" Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e
    jsToDoc (ApplStat JExpr
e [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 JStat
s Ident
i JStat
s1 JStat
s2) = Text -> Doc
text 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 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 Text
"finally" Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (JStat -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JStat
s2)
    jsToDoc (AssignStat JExpr
i JExpr
x) = JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
i Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x
    jsToDoc (PPostStat Bool
isPre [Char]
op 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 [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] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")`"
    jsToDoc (ForeignStat Ident
i JLocalType
t) = Text -> Doc
text Text
"//foriegn" Doc -> Doc -> Doc
<+> Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"::" Doc -> Doc -> Doc
<+> JLocalType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JLocalType
t
    jsToDoc (BlockStat [JStat]
xs) = [JStat] -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc ([JStat] -> [JStat]
flattenBlocks [JStat]
xs)

flattenBlocks :: [JStat] -> [JStat]
flattenBlocks :: [JStat] -> [JStat]
flattenBlocks (BlockStat [JStat]
y:[JStat]
ys) = [JStat] -> [JStat]
flattenBlocks [JStat]
y [JStat] -> [JStat] -> [JStat]
forall a. [a] -> [a] -> [a]
++ [JStat] -> [JStat]
flattenBlocks [JStat]
ys
flattenBlocks (JStat
y:[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 JExpr
x = case JExpr
x of
                (PPostExpr Bool
_ [Char]
_ JExpr
_) -> Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x)
                JExpr
_ -> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x

instance JsToDoc JExpr where
    jsToDoc :: JExpr -> Doc
jsToDoc (ValExpr JVal
x) = JVal -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JVal
x
    jsToDoc (SelExpr JExpr
x 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 Char
'.', Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
y]
    jsToDoc (IdxExpr JExpr
x 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 JExpr
x JExpr
y JExpr
z) = Doc -> Doc
parens (JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
y Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
z)
    jsToDoc (InfixExpr [Char]
op JExpr
x 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
== [Char]
"++" = [Char]
"+"
                  | Bool
otherwise = [Char]
op

    jsToDoc (PPostExpr Bool
isPre [Char]
op 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 JExpr
je [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 JExpr
e) = Text -> Doc
text Text
"new" Doc -> Doc -> Doc
<+> JExpr -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e
    jsToDoc (AntiExpr [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] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")`"
    jsToDoc (TypeExpr Bool
b JExpr
e 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 Text
"/* ::!" else Text
"/* ::") Doc -> Doc -> Doc
<+> JLocalType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JLocalType
t Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"*/"
    jsToDoc (UnsatExpr 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 Ident
i) = Ident -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i
    jsToDoc (JList [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 Double
d)) = Double -> Doc
double Double
d
    jsToDoc (JInt Integer
i) = Integer -> Doc
integer Integer
i
    jsToDoc (JStr [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] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char] -> [Char]
encodeJson [Char]
s[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\""
    jsToDoc (JRegEx [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] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
s[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"/"
    jsToDoc (JHash Map [Char] JExpr
m)
            | Map [Char] JExpr -> Bool
forall k a. Map k a -> Bool
M.null Map [Char] JExpr
m = Text -> Doc
text 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 (\([Char]
x,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 [Ident]
is JStat
b) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Text -> Doc
text 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 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 [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 JType
JTNum = Text -> Doc
text Text
"Num"
    jsToDoc JType
JTString = Text -> Doc
text Text
"String"
    jsToDoc JType
JTBool = Text -> Doc
text Text
"Bool"
    jsToDoc JType
JTStat = Text -> Doc
text Text
"()"
    jsToDoc JType
JTImpossible = Text -> Doc
text Text
"_|_" -- "⊥"
    jsToDoc (JTForall [VarRef]
vars JType
t) = Text -> Doc
text 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 Text
"." Doc -> Doc -> Doc
<+> JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
t
    jsToDoc (JTFunc [JType]
args 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 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 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 JType
t) = Text -> Doc
text Text
"Map" Doc -> Doc -> Doc
<+> JType -> Doc
ppType JType
t
    jsToDoc (JTRecord JType
t 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 (\([Char]
x,JType
y) -> Text -> Doc
text ([Char] -> Text
T.pack [Char]
x) Doc -> Doc -> Doc
<+> Text -> Doc
text 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 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 Text
"]"
    jsToDoc (JTFree VarRef
ref) = VarRef -> Doc
forall a. Show a => (Maybe [Char], a) -> Doc
ppRef VarRef
ref
    jsToDoc (JTRigid VarRef
ref Set Constraint
cs) = Text -> Doc
text 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 Text
"]"
{-
        maybe (text "") (text " / " <>)
                  (ppConstraintList . map (\x -> (ref,x)) $ S.toList cs) <>
        text "]"
-}

instance JsToDoc JLocalType where
    jsToDoc :: JLocalType -> Doc
jsToDoc ([(VarRef, Constraint)]
cs,JType
t) = Doc -> (Doc -> Doc) -> Maybe Doc -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Doc
text Text
"") (Doc -> Doc -> Doc
<+> Text -> Doc
text 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 [((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 ((Maybe [Char], a)
vr,Sub   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 Text
"<:" Doc -> Doc -> Doc
<+> JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
t'
      go ((Maybe [Char], a)
vr,Super JType
t') = JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
t' Doc -> Doc -> Doc
<+> Text -> Doc
text 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 [Char]
n,a
_) = 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 (Maybe [Char]
_,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
$ [Char]
"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 [JType]
_ JType
_) = 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 JType
_) = 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 JType
x = JType -> Doc
forall a. JsToDoc a => a -> Doc
jsToDoc JType
x

{--------------------------------------------------------------------
  ToJExpr Class
--------------------------------------------------------------------}


-- | Things that can be marshalled into javascript values.
-- Instantiate for any necessary data structures.
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 Bool
True  = [Char] -> JExpr
jsv [Char]
"true"
    toJExpr Bool
False = [Char] -> JExpr
jsv [Char]
"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
--        where escQuotes = tailDef "" . initDef "" . show

instance ToJExpr TS.Text where
    toJExpr :: Text -> JExpr
toJExpr 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 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,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,b
b,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,b
b,c
c,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,b
b,c
c,d
d,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,b
b,c
c,d
d,e
e,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
    JExpr
x + :: JExpr -> JExpr -> JExpr
+ JExpr
y = [Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
"+" JExpr
x JExpr
y
    JExpr
x - :: JExpr -> JExpr -> JExpr
- JExpr
y = [Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
"-" JExpr
x JExpr
y
    JExpr
x * :: JExpr -> JExpr -> JExpr
* JExpr
y = [Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
"*" JExpr
x JExpr
y
    abs :: JExpr -> JExpr
abs JExpr
x = JExpr -> [JExpr] -> JExpr
ApplExpr ([Char] -> JExpr
jsv [Char]
"Math.abs") [JExpr
x]
    signum :: JExpr -> JExpr
signum JExpr
x = JExpr -> JExpr -> JExpr -> JExpr
IfExpr ([Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
">" JExpr
x JExpr
0) JExpr
1 (JExpr -> JExpr -> JExpr -> JExpr
IfExpr ([Char] -> JExpr -> JExpr -> JExpr
InfixExpr [Char]
"==" JExpr
x JExpr
0) JExpr
0 (-JExpr
1))

{--------------------------------------------------------------------
  Block Sugar
--------------------------------------------------------------------}

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

{--------------------------------------------------------------------
  Combinators
--------------------------------------------------------------------}

-- | Create a new anonymous function. The result is an expression.
-- Usage:
-- @jLam $ \ x y -> {JExpr involving x and y}@
jLam :: (ToSat a) => a -> JExpr
jLam :: a -> JExpr
jLam 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
           (JStat
block,[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

-- | Introduce a new variable into scope for the duration
-- of the enclosed expression. The result is a block statement.
-- Usage:
-- @jVar $ \ x y -> {JExpr involving x and y}@
jVar :: (ToSat a) => a -> JStat
jVar :: a -> JStat
jVar 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
           (JStat
block, [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 [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 (\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 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


-- | Introduce a new variable with optional type into scope for the duration
-- of the enclosed expression. The result is a block statement.
-- Usage:
-- @jVar $ \ x y -> {JExpr involving x and y}@
jVarTy :: (ToSat a) => a -> (Maybe JLocalType) -> JStat
jVarTy :: a -> Maybe JLocalType -> JStat
jVarTy a
f 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
           (JStat
block, [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 [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 (\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 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


-- | Create a for in statement.
-- Usage:
-- @jForIn {expression} $ \x -> {block involving x}@
jForIn :: ToSat a => JExpr -> (JExpr -> a)  -> JStat
jForIn :: JExpr -> (JExpr -> a) -> JStat
jForIn JExpr
e 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
               (JStat
block, [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 [Char]
"jForIn" [Ident]
is) JExpr
e JStat
block

-- | As with "jForIn" but creating a \"for each in\" statement.
jForEachIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
jForEachIn :: JExpr -> (JExpr -> a) -> JStat
jForEachIn JExpr
e 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
               (JStat
block, [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 [Char]
"jForIn" [Ident]
is) JExpr
e JStat
block

jTryCatchFinally :: (ToSat a) => JStat -> a -> JStat -> JStat
jTryCatchFinally :: JStat -> a -> JStat -> JStat
jTryCatchFinally JStat
s a
f 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
                     (JStat
block, [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 [Char]
"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 JStat
before a
p JStat
after 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 [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]
                 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 [Char]
k 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  [Char]
k a
v 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 JType
t [([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 []

-- Aeson instance
instance ToJExpr Value where
    toJExpr :: Value -> JExpr
toJExpr Value
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 [Char]
"null"
    toJExpr (Bool 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 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 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 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
#if MIN_VERSION_aeson (2,0,0)
    toJExpr (Object 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
$ ((Key, Value) -> ([Char], JExpr))
-> [(Key, Value)] -> [([Char], JExpr)]
forall a b. (a -> b) -> [a] -> [b]
map (Key -> [Char]
KM.toString (Key -> [Char])
-> (Value -> JExpr) -> (Key, 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) ([(Key, Value)] -> [([Char], JExpr)])
-> [(Key, Value)] -> [([Char], JExpr)]
forall a b. (a -> b) -> a -> b
$ Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
obj
#else
    toJExpr (Object obj)     = ValExpr $ JHash $ M.fromList $ map (TS.unpack *** toJExpr) $ HM.toList obj
#endif

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

-- Taken from json package by Sigbjorn Finne.

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 Char
'/'  = [Char]
"\\/"
encodeJsonChar Char
'\b' = [Char]
"\\b"
encodeJsonChar Char
'\f' = [Char]
"\\f"
encodeJsonChar Char
'\n' = [Char]
"\\n"
encodeJsonChar Char
'\r' = [Char]
"\\r"
encodeJsonChar Char
'\t' = [Char]
"\\t"
encodeJsonChar Char
'"' = [Char]
"\\\""
encodeJsonChar Char
'\\' = [Char]
"\\\\"
encodeJsonChar 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
< Char
'\x10'   = Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'u' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
hexxs
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x100'  = Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'u' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
hexxs
    | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\x1000' = Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'u' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'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) [Char]
"" -- FIXME
encodeJsonChar Char
c = [Char
c]