{-# 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 (ap, return, liftM2)
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 forall a b. (a -> b) -> a -> b
$ Doc
x Doc -> Doc -> Doc
$+$ Doc
y)

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

newtype IdentSupply a = IS {forall a. IdentSupply a -> State [Ident] a
runIdentSupply :: State [Ident] a} deriving Typeable

inIdentSupply :: (State [Ident] a -> State [Ident] b) -> IdentSupply a -> IdentSupply b
inIdentSupply :: forall a b.
(State [Ident] a -> State [Ident] b)
-> IdentSupply a -> IdentSupply b
inIdentSupply State [Ident] a -> State [Ident] b
f IdentSupply a
x = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ State [Ident] a -> State [Ident] b
f (forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply a
x)

instance Data a => Data (IdentSupply a) where
    gunfold :: forall (c :: * -> *).
(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
_ = forall a. HasCallStack => String -> a
error String
"gunfold IdentSupply"
    toConstr :: IdentSupply a -> Constr
toConstr IdentSupply a
_ = forall a. HasCallStack => String -> a
error String
"toConstr IdentSupply"
    dataTypeOf :: IdentSupply a -> DataType
dataTypeOf IdentSupply a
_ = String -> DataType
mkNoRepType String
"IdentSupply"

instance Functor IdentSupply where
    fmap :: forall a b. (a -> b) -> IdentSupply a -> IdentSupply b
fmap a -> b
f IdentSupply a
x = forall a b.
(State [Ident] a -> State [Ident] b)
-> IdentSupply a -> IdentSupply b
inIdentSupply (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
  forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            (Ident
x:[Ident]
xs) -> do
               forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
xs
               forall (m :: * -> *) a. Monad m => a -> m a
return Ident
x
            [Ident]
_ -> forall a. HasCallStack => String -> a
error String
"not enough elements"

newIdentSupply :: Maybe String -> [Ident]
newIdentSupply :: Maybe String -> [Ident]
newIdentSupply Maybe String
Nothing     = Maybe String -> [Ident]
newIdentSupply (forall a. a -> Maybe a
Just String
"jmId")
newIdentSupply (Just String
pfx') = [String -> Ident
StrI (String
pfx forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
x) | Integer
x <- [(Integer
0::Integer)..]]
    where pfx :: String
pfx = String
pfx'forall a. [a] -> [a] -> [a]
++[Char
'_']

sat_ :: IdentSupply a -> a
sat_ :: forall a. IdentSupply a -> a
sat_ IdentSupply a
x = forall s a. State s a -> s -> a
evalState (forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply a
x) forall a b. (a -> b) -> a -> b
$ Maybe String -> [Ident]
newIdentSupply (forall a. a -> Maybe a
Just String
"<<unsatId>>")

instance Eq a => Eq (IdentSupply a) where
    == :: IdentSupply a -> IdentSupply a -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IdentSupply a -> a
sat_
instance Ord a => Ord (IdentSupply a) where
    compare :: IdentSupply a -> IdentSupply a -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IdentSupply a -> a
sat_
instance Show a => Show (IdentSupply a) where
    show :: IdentSupply a -> String
show IdentSupply a
x = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. IdentSupply a -> a
sat_ IdentSupply a
x) forall a. [a] -> [a] -> [a]
++ String
")"


--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
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
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
Ord, Int -> JStat -> ShowS
[JStat] -> ShowS
JStat -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JStat] -> ShowS
$cshowList :: [JStat] -> ShowS
show :: JStat -> String
$cshow :: JStat -> String
showsPrec :: Int -> JStat -> ShowS
$cshowsPrec :: Int -> JStat -> ShowS
Show, Typeable JStat
JStat -> DataType
JStat -> Constr
(forall b. Data b => b -> b) -> JStat -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> JStat -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JStat -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> JStat -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JStat -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable)

type JsLabel = String


instance Semigroup JStat where
    <> :: JStat -> JStat -> JStat
(<>) (BlockStat [JStat]
xs) (BlockStat [JStat]
ys) = [JStat] -> JStat
BlockStat forall a b. (a -> b) -> a -> b
$ [JStat]
xs forall a. [a] -> [a] -> [a]
++ [JStat]
ys
    (<>) (BlockStat [JStat]
xs) JStat
ys = [JStat] -> JStat
BlockStat forall a b. (a -> b) -> a -> b
$ [JStat]
xs forall a. [a] -> [a] -> [a]
++ [JStat
ys]
    (<>) JStat
xs (BlockStat [JStat]
ys) = [JStat] -> JStat
BlockStat forall a b. (a -> b) -> a -> b
$ JStat
xs 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 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
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
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
Ord, Int -> JExpr -> ShowS
[JExpr] -> ShowS
JExpr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JExpr] -> ShowS
$cshowList :: [JExpr] -> ShowS
show :: JExpr -> String
$cshow :: JExpr -> String
showsPrec :: Int -> JExpr -> ShowS
$cshowsPrec :: Int -> JExpr -> ShowS
Show, Typeable JExpr
JExpr -> DataType
JExpr -> Constr
(forall b. Data b => b -> b) -> JExpr -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> JExpr -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JExpr -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> JExpr -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JExpr -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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
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
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
Ord, Int -> JVal -> ShowS
[JVal] -> ShowS
JVal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVal] -> ShowS
$cshowList :: [JVal] -> ShowS
show :: JVal -> String
$cshow :: JVal -> String
showsPrec :: Int -> JVal -> ShowS
$cshowsPrec :: Int -> JVal -> ShowS
Show, Typeable JVal
JVal -> DataType
JVal -> Constr
(forall b. Data b => b -> b) -> JVal -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> JVal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JVal -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> JVal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JVal -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable)

newtype SaneDouble = SaneDouble Double deriving (Typeable SaneDouble
SaneDouble -> DataType
SaneDouble -> Constr
(forall b. Data b => b -> b) -> SaneDouble -> SaneDouble
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SaneDouble -> u
forall u. (forall d. Data d => d -> u) -> SaneDouble -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SaneDouble
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SaneDouble -> c SaneDouble
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SaneDouble)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SaneDouble)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SaneDouble -> m SaneDouble
gmapM :: forall (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> SaneDouble -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SaneDouble -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SaneDouble -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SaneDouble -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SaneDouble -> r
gmapQl :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, Num 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
Fractional, Integer -> SaneDouble
SaneDouble -> SaneDouble
SaneDouble -> SaneDouble -> 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 forall a. Eq a => a -> a -> Bool
== Double
y Bool -> Bool -> Bool
|| (forall a. RealFloat a => a -> Bool
isNaN Double
x Bool -> Bool -> 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) = forall a. Ord a => a -> a -> Ordering
compare (forall {a}. RealFloat a => a -> Maybe a
fromNaN Double
x) (forall {a}. RealFloat a => a -> Maybe a
fromNaN Double
y)
        where fromNaN :: a -> Maybe a
fromNaN a
z | forall a. RealFloat a => a -> Bool
isNaN a
z = forall a. Maybe a
Nothing
                        | Bool
otherwise = forall a. a -> Maybe a
Just a
z

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

-- | Identifiers
newtype Ident = StrI String deriving (Ident -> Ident -> Bool
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
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
Ord, Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> String
$cshow :: Ident -> String
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show, Typeable Ident
Ident -> DataType
Ident -> Constr
(forall b. Data b => b -> b) -> Ident -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ident -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ident -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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 String
s JExpr
x) = Bool -> String -> JExpr -> JStat
PPostStat Bool
b String
s JExpr
x
expr2stat (AntiExpr String
x) = String -> JStat
AntiStat String
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
_ = forall a. HasCallStack => String -> a
error String
"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
_ = forall a. HasCallStack => String -> a
error String
"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
_ = forall a. HasCallStack => String -> a
error String
"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
_ = forall a. HasCallStack => String -> a
error String
"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 (t :: * -> *) b.
Compos t =>
(forall a. t a -> t a) -> t b -> t b
composOp forall a. t a -> t a
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m (t a)) -> t b -> m (t b)
composOpM = 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 (m :: * -> *) a. Monad m => a -> m a
return 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 (t :: * -> *) (m :: * -> *) b.
(Compos t, Monad m) =>
(forall a. t a -> m ()) -> t b -> m ()
composOpM_ = forall (t :: * -> *) b c.
Compos t =>
b -> (b -> b -> b) -> (forall a. t a -> b) -> t c -> b
composOpFold (forall (m :: * -> *) a. Monad m => a -> m a
return ()) 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 :: forall (t :: * -> *) b c.
Compos t =>
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 = forall b a. C b a -> b
unC forall b c a. (b -> c) -> (a -> b) -> a -> 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
_ -> forall b a. b -> C b a
C b
z) (\(C b
x) (C b
y) -> forall b a. b -> C b a
C (b -> b -> b
c b
x b
y)) (forall b a. b -> C b a
C forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. t a -> b
f)
newtype C b a = C { forall b a. 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 (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)
compos = 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 (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
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
_ -> forall a. a -> m a
ret JMGadt c
v
     JMGStat JStat
v' -> forall a. a -> m a
ret JStat -> JMGadt JStat
JMGStat forall a b. m (a -> b) -> m a -> m b
`app` case JStat
v' of
           DeclStat Ident
i Maybe JLocalType
t -> forall a. a -> m a
ret Ident -> Maybe JLocalType -> JStat
DeclStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
i forall a b. m (a -> b) -> m a -> m b
`app` forall a. a -> m a
ret Maybe JLocalType
t
           ReturnStat JExpr
i -> forall a. a -> m a
ret JExpr -> JStat
ReturnStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
i
           IfStat JExpr
e JStat
s JStat
s' -> forall a. a -> m a
ret JExpr -> JStat -> JStat -> JStat
IfStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s'
           WhileStat Bool
b JExpr
e JStat
s -> forall a. a -> m a
ret (Bool -> JExpr -> JStat -> JStat
WhileStat Bool
b) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s
           ForInStat Bool
b Ident
i JExpr
e JStat
s -> forall a. a -> m a
ret (Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
i forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s
           SwitchStat JExpr
e [(JExpr, JStat)]
l JStat
d -> forall a. a -> m a
ret JExpr -> [(JExpr, JStat)] -> JStat -> JStat
SwitchStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` m [(JExpr, JStat)]
l' forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
d
               where l' :: m [(JExpr, JStat)]
l' = forall a. (a -> m a) -> [a] -> m [a]
mapM' (\(JExpr
c,JStat
s) -> forall a. a -> m a
ret (,) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
c forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s) [(JExpr, JStat)]
l
           BlockStat [JStat]
xs -> forall a. a -> m a
ret [JStat] -> JStat
BlockStat forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JStat]
xs
           ApplStat  JExpr
e [JExpr]
xs -> forall a. a -> m a
ret JExpr -> [JExpr] -> JStat
ApplStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JExpr]
xs
           TryStat JStat
s Ident
i JStat
s1 JStat
s2 -> forall a. a -> m a
ret JStat -> Ident -> JStat -> JStat -> JStat
TryStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
i forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s1 forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s2
           PPostStat Bool
b String
o JExpr
e -> forall a. a -> m a
ret (Bool -> String -> JExpr -> JStat
PPostStat Bool
b String
o) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e
           AssignStat JExpr
e JExpr
e' -> forall a. a -> m a
ret JExpr -> JExpr -> JStat
AssignStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e'
           UnsatBlock IdentSupply JStat
_ -> forall a. a -> m a
ret JStat
v'
           AntiStat String
_ -> forall a. a -> m a
ret JStat
v'
           ForeignStat Ident
i JLocalType
t -> forall a. a -> m a
ret Ident -> JLocalType -> JStat
ForeignStat forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
i forall a b. m (a -> b) -> m a -> m b
`app` forall a. a -> m a
ret JLocalType
t
           ContinueStat Maybe String
l -> forall a. a -> m a
ret (Maybe String -> JStat
ContinueStat Maybe String
l)
           BreakStat Maybe String
l -> forall a. a -> m a
ret (Maybe String -> JStat
BreakStat Maybe String
l)
           LabelStat String
l JStat
s -> forall a. a -> m a
ret (String -> JStat -> JStat
LabelStat String
l) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s
     JMGExpr JExpr
v' -> forall a. a -> m a
ret JExpr -> JMGadt JExpr
JMGExpr forall a b. m (a -> b) -> m a -> m b
`app` case JExpr
v' of
           ValExpr JVal
e -> forall a. a -> m a
ret JVal -> JExpr
ValExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JVal
e
           SelExpr JExpr
e Ident
e' -> forall a. a -> m a
ret JExpr -> Ident -> JExpr
SelExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
e'
           IdxExpr JExpr
e JExpr
e' -> forall a. a -> m a
ret JExpr -> JExpr -> JExpr
IdxExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e'
           InfixExpr String
o JExpr
e JExpr
e' -> forall a. a -> m a
ret (String -> JExpr -> JExpr -> JExpr
InfixExpr String
o) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e'
           PPostExpr Bool
b String
o JExpr
e -> forall a. a -> m a
ret (Bool -> String -> JExpr -> JExpr
PPostExpr Bool
b String
o) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e
           IfExpr JExpr
e JExpr
e' JExpr
e'' -> forall a. a -> m a
ret JExpr -> JExpr -> JExpr -> JExpr
IfExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e' forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e''
           NewExpr JExpr
e -> forall a. a -> m a
ret JExpr -> JExpr
NewExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e
           ApplExpr JExpr
e [JExpr]
xs -> forall a. a -> m a
ret JExpr -> [JExpr] -> JExpr
ApplExpr forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JExpr]
xs
           AntiExpr String
_ -> forall a. a -> m a
ret JExpr
v'
           TypeExpr Bool
b JExpr
e JLocalType
t -> forall a. a -> m a
ret (Bool -> JExpr -> JLocalType -> JExpr
TypeExpr Bool
b) forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JExpr
e forall a b. m (a -> b) -> m a -> m b
`app` forall a. a -> m a
ret JLocalType
t
           UnsatExpr IdentSupply JExpr
_ -> forall a. a -> m a
ret JExpr
v'
     JMGVal JVal
v' -> forall a. a -> m a
ret JVal -> JMGadt JVal
JMGVal forall a b. m (a -> b) -> m a -> m b
`app` case JVal
v' of
           JVar Ident
i -> forall a. a -> m a
ret Ident -> JVal
JVar forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f Ident
i
           JList [JExpr]
xs -> forall a. a -> m a
ret [JExpr] -> JVal
JList forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JExpr]
xs
           JDouble SaneDouble
_ -> forall a. a -> m a
ret JVal
v'
           JInt    Integer
_ -> forall a. a -> m a
ret JVal
v'
           JStr    String
_ -> forall a. a -> m a
ret JVal
v'
           JRegEx  String
_ -> forall a. a -> m a
ret JVal
v'
           JHash   Map String JExpr
m -> forall a. a -> m a
ret Map String JExpr -> JVal
JHash forall a b. m (a -> b) -> m a -> m b
`app` m (Map String JExpr)
m'
               where ([String]
ls, [JExpr]
vs) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall k a. Map k a -> [(k, a)]
M.toList Map String JExpr
m)
                     m' :: m (Map String JExpr)
m' = forall a. a -> m a
ret (forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ls) forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [JExpr]
vs
           JFunc [Ident]
xs JStat
s -> forall a. a -> m a
ret [Ident] -> JStat -> JVal
JFunc forall a b. m (a -> b) -> m a -> m b
`app` forall a. (a -> m a) -> [a] -> m [a]
mapM' forall b. JMacro b => b -> m b
f [Ident]
xs forall a b. m (a -> b) -> m a -> m b
`app` forall b. JMacro b => b -> m b
f JStat
s
           UnsatVal IdentSupply JVal
_ -> forall a. a -> m a
ret JVal
v'

  where
    mapM' :: forall a. (a -> m a) -> [a] -> m [a]
    mapM' :: forall a. (a -> m a) -> [a] -> m [a]
mapM' a -> m a
g = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b. m (a -> b) -> m a -> m b
app forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. m (a -> b) -> m a -> m b
app (forall a. a -> m a
ret (:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
g) (forall a. a -> m a
ret [])
    f :: forall b. JMacro b => b -> m b
    f :: forall b. JMacro b => b -> m b
f b
x = forall a. a -> m a
ret forall a. JMacro a => JMGadt a -> a
jfromGADT forall a b. m (a -> b) -> m a -> m b
`app` forall a. JMGadt a -> m (JMGadt a)
f' (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 = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ([JStat] -> JStat
BlockStat [JStat]
f, forall a. [a] -> [a]
reverse [Ident]
vs)

instance ToSat JStat where
    toSat_ :: JStat -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JStat
f [Ident]
vs = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (JStat
f, forall a. [a] -> [a]
reverse [Ident]
vs)

instance ToSat JExpr where
    toSat_ :: JExpr -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JExpr
f [Ident]
vs = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (JExpr -> JStat
expr2stat JExpr
f, forall a. [a] -> [a]
reverse [Ident]
vs)

instance ToSat [JExpr] where
    toSat_ :: [JExpr] -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ [JExpr]
f [Ident]
vs = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ([JStat] -> JStat
BlockStat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map JExpr -> JStat
expr2stat [JExpr]
f, 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 = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ do
      Ident
x <- State [Ident] Ident
takeOne
      forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ (b -> a
f (JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar Ident
x)) (Ident
xforall 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 :: forall a. JMacro a => Maybe String -> a -> a
jsSaturate Maybe String
str a
x = forall s a. State s a -> s -> a
evalState (forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => a -> IdentSupply a
jsSaturate_ a
x) (Maybe String -> [Ident]
newIdentSupply Maybe String
str)

jsSaturate_ :: (JMacro a) => a -> IdentSupply a
jsSaturate_ :: forall a. JMacro a => a -> IdentSupply a
jsSaturate_ a
e = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => JMGadt a -> a
jfromGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMGadt a -> State [Ident] (JMGadt a)
go (forall a. JMacro a => a -> JMGadt a
jtoGADT a
e)
    where
      go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
      go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
go JMGadt a
v = case JMGadt a
v of
               JMGStat (UnsatBlock IdentSupply JStat
us) -> forall a. JMGadt a -> State [Ident] (JMGadt a)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JStat -> JMGadt JStat
JMGStat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JStat
us)
               JMGExpr (UnsatExpr  IdentSupply JExpr
us) -> forall a. JMGadt a -> State [Ident] (JMGadt a)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JExpr -> JMGadt JExpr
JMGExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JExpr
us)
               JMGVal  (UnsatVal   IdentSupply JVal
us) -> forall a. JMGadt a -> State [Ident] (JMGadt a)
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (JVal -> JMGadt JVal
JMGVal  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IdentSupply a -> State [Ident] a
runIdentSupply IdentSupply JVal
us)
               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_ :: forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ [(Ident, Ident)]
xs a
e = forall a. JMacro a => JMGadt a -> a
jfromGADT forall a b. (a -> b) -> a -> b
$ forall a. JMGadt a -> JMGadt a
go (forall a. JMacro a => a -> JMGadt a
jtoGADT a
e)
    where
      go :: forall a. JMGadt a -> JMGadt a
      go :: forall a. JMGadt a -> JMGadt a
go JMGadt a
v = case JMGadt a
v of
                   JMGId Ident
i -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe JMGadt a
v Ident -> JMGadt Ident
JMGId (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Ident
i Map Ident Ident
mp)
                   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 = 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_ :: forall a. JMacro a => [Ident] -> a -> IdentSupply a
jsUnsat_ [Ident]
xs a
e = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ do
  ([Ident]
idents,[Ident]
is') <- forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
xs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
is'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ (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 :: forall a. JMacro a => (a -> a) -> a -> a
withHygiene a -> a
f a
x = forall a. JMacro a => JMGadt a -> a
jfromGADT forall a b. (a -> b) -> a -> b
$ case forall a. JMacro a => a -> JMGadt a
jtoGADT a
x of
    JMGExpr JExpr
z -> JExpr -> JMGadt JExpr
JMGExpr forall a b. (a -> b) -> a -> b
$ IdentSupply JExpr -> JExpr
UnsatExpr forall a b. (a -> b) -> a -> b
$ a -> IdentSupply a
inScope JExpr
z
    JMGStat JStat
z -> JStat -> JMGadt JStat
JMGStat forall a b. (a -> b) -> a -> b
$ IdentSupply JStat -> JStat
UnsatBlock forall a b. (a -> b) -> a -> b
$ a -> IdentSupply a
inScope JStat
z
    JMGVal  JVal
z -> JVal -> JMGadt JVal
JMGVal forall a b. (a -> b) -> a -> b
$ IdentSupply JVal -> JVal
UnsatVal forall a b. (a -> b) -> a -> b
$ a -> IdentSupply a
inScope JVal
z
    JMGId Ident
_ -> forall a. JMacro a => a -> JMGadt a
jtoGADT forall a b. (a -> b) -> a -> b
$ a -> a
f a
x
    where
        inScope :: a -> IdentSupply a
inScope a
z = forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ do
            forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              ([StrI String
a], [Ident]
b) -> do
                forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
b
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => String -> (a -> a) -> a -> a
withHygiene_ String
a a -> a
f a
z
              ([Ident], [Ident])
_ -> forall a. HasCallStack => String -> a
error String
"Not as string"

withHygiene_ :: JMacro a => String -> (a -> a) -> a -> a
withHygiene_ :: forall a. JMacro a => String -> (a -> a) -> a -> a
withHygiene_ String
un a -> a
f a
x = forall a. JMacro a => JMGadt a -> a
jfromGADT forall a b. (a -> b) -> a -> b
$ case forall a. JMacro a => a -> JMGadt a
jtoGADT a
x of
    JMGStat JStat
_ -> forall a. JMacro a => a -> JMGadt a
jtoGADT forall a b. (a -> b) -> a -> b
$ IdentSupply JStat -> JStat
UnsatBlock (forall a. JMacro a => [Ident] -> a -> IdentSupply a
jsUnsat_ [Ident]
is' a
x'')
    JMGExpr JExpr
_ -> forall a. JMacro a => a -> JMGadt a
jtoGADT forall a b. (a -> b) -> a -> b
$ IdentSupply JExpr -> JExpr
UnsatExpr (forall a. JMacro a => [Ident] -> a -> IdentSupply a
jsUnsat_ [Ident]
is' a
x'')
    JMGVal  JVal
_ -> forall a. JMacro a => a -> JMGadt a
jtoGADT forall a b. (a -> b) -> a -> b
$ IdentSupply JVal -> JVal
UnsatVal (forall a. JMacro a => [Ident] -> a -> IdentSupply a
jsUnsat_ [Ident]
is' a
x'')
    JMGId Ident
_ -> forall a. JMacro a => a -> JMGadt a
jtoGADT forall a b. (a -> b) -> a -> b
$ a -> a
f a
x
    where
        (a
x', (StrI String
l : [Ident]
_)) = forall s a. State s a -> s -> (a, s)
runState (forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => a -> IdentSupply a
jsSaturate_ a
x) [Ident]
is
        is' :: [Ident]
is' = forall a. Int -> [a] -> [a]
take Int
lastVal [Ident]
is
        x'' :: a
x'' = a -> a
f a
x'
        lastVal :: Int
lastVal = forall a. (HasCallStack, Read a) => String -> String -> a
readNote (String
"inSat" forall a. [a] -> [a] -> [a]
++ String
un) (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'_') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ String
l) :: Int
        is :: [Ident]
is = Maybe String -> [Ident]
newIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (String
"inSat" forall a. [a] -> [a] -> [a]
++ String
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 = forall s a. State s a -> s -> a
evalState (forall a. JMacro a => JMGadt a -> a
jfromGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMGadt a -> State [Ident] (JMGadt a)
go (forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
x)) (Maybe String -> [Ident]
newIdentSupply forall a. Maybe a
Nothing)
    where go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
          go :: forall a. JMGadt a -> State [Ident] (JMGadt a)
go JMGadt a
v = case JMGadt a
v of
                   (JMGStat (BlockStat [JStat]
ss)) -> JStat -> JMGadt JStat
JMGStat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JStat] -> JStat
BlockStat 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 [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
                             blocks (DeclStat (StrI String
i) Maybe JLocalType
t : [JStat]
xs) =  case String
i of
                                (Char
'!':Char
'!':String
i') -> (Ident -> Maybe JLocalType -> JStat
DeclStat (String -> Ident
StrI String
i') Maybe JLocalType
tforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JStat] -> StateT [Ident] Identity [JStat]
blocks [JStat]
xs
                                (Char
'!':String
i') -> (Ident -> Maybe JLocalType -> JStat
DeclStat (String -> Ident
StrI String
i') Maybe JLocalType
tforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JStat] -> StateT [Ident] Identity [JStat]
blocks [JStat]
xs
                                String
_ -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                     (Ident
newI:[Ident]
st) -> do
                                       forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
st
                                       [JStat]
rest <- [JStat] -> StateT [Ident] Identity [JStat]
blocks [JStat]
xs
                                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Ident -> Maybe JLocalType -> JStat
DeclStat Ident
newI Maybe JLocalType
t forall a. Monoid a => a -> a -> a
`mappend` forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ [(String -> Ident
StrI String
i, Ident
newI)] ([JStat] -> JStat
BlockStat [JStat]
rest)]
                                     [Ident]
_ -> forall a. HasCallStack => String -> a
error String
"scopify"
                             blocks (JStat
x':[JStat]
xs) = (forall a. JMacro a => JMGadt a -> a
jfromGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMGadt a -> State [Ident] (JMGadt a)
go (forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
x')) forall {a1}.
StateT [Ident] Identity a1
-> StateT [Ident] Identity [a1] -> StateT [Ident] Identity [a1]
<:> [JStat] -> StateT [Ident] Identity [JStat]
blocks [JStat]
xs
                             <:> :: StateT [Ident] Identity a1
-> StateT [Ident] Identity [a1] -> StateT [Ident] Identity [a1]
(<:>) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:)
                   (JMGStat (ForInStat Bool
b (StrI String
i) JExpr
e JStat
s)) -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                          (Ident
newI:[Ident]
st) -> do
                             forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
st
                             JStat
rest <- forall a. JMacro a => JMGadt a -> a
jfromGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMGadt a -> State [Ident] (JMGadt a)
go (forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s)
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ JStat -> JMGadt JStat
JMGStat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
b Ident
newI JExpr
e forall a b. (a -> b) -> a -> b
$ forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ [(String -> Ident
StrI String
i, Ident
newI)] JStat
rest
                          [Ident]
_ -> forall a. HasCallStack => String -> a
error String
"scopify2"
                   (JMGStat (TryStat JStat
s (StrI String
i) JStat
s1 JStat
s2)) -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                          (Ident
newI:[Ident]
st) -> do
                            forall s (m :: * -> *). MonadState s m => s -> m ()
put [Ident]
st
                            JStat
t <- forall a. JMacro a => JMGadt a -> a
jfromGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMGadt a -> State [Ident] (JMGadt a)
go (forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s)
                            JStat
c <- forall a. JMacro a => JMGadt a -> a
jfromGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMGadt a -> State [Ident] (JMGadt a)
go (forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s1)
                            JStat
f <- forall a. JMacro a => JMGadt a -> a
jfromGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMGadt a -> State [Ident] (JMGadt a)
go (forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s2)
                            forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> JMGadt JStat
JMGStat forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> Ident -> JStat -> JStat -> JStat
TryStat JStat
t Ident
newI (forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ [(String -> Ident
StrI String
i, Ident
newI)] JStat
c) forall a b. (a -> b) -> a -> b
$ JStat
f
                          [Ident]
_ -> forall a. HasCallStack => String -> a
error String
"scopify3"
                   (JMGExpr (ValExpr (JFunc [Ident]
is JStat
s))) -> do
                            [Ident]
st <- forall s (m :: * -> *). MonadState s m => m s
get
                            let ([Ident]
newIs,[Ident]
newSt) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ident]
is) [Ident]
st
                            forall s (m :: * -> *). MonadState s m => s -> m ()
put ([Ident]
newSt)
                            JStat
rest <- forall a. JMacro a => JMGadt a -> a
jfromGADT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. JMGadt a -> State [Ident] (JMGadt a)
go (forall a. JMacro a => a -> JMGadt a
jtoGADT JStat
s)
                            forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. JExpr -> JMGadt JExpr
JMGExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ [Ident] -> JStat -> JVal
JFunc [Ident]
newIs forall a b. (a -> b) -> a -> b
$ (forall a. JMacro a => [(Ident, Ident)] -> a -> a
jsReplace_ forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
is [Ident]
newIs) JStat
rest
                   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 :: forall a. (JsToDoc a, JMacro a) => a -> Doc
renderJs = forall a. JsToDoc a => a -> Doc
jsToDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. JMacro a => Maybe String -> a -> a
jsSaturate 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 :: forall a. (JsToDoc a, JMacro a) => String -> a -> Doc
renderPrefixJs String
pfx = forall a. JsToDoc a => a -> Doc
jsToDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. JMacro a => Maybe String -> a -> a
jsSaturate (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"jmId_"forall a. [a] -> [a] -> [a]
++String
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" forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
cond) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (forall a. JsToDoc a => a -> Doc
jsToDoc JStat
x) Doc -> Doc -> Doc
$$ Doc
mbElse
        where mbElse :: Doc
mbElse | JStat
y 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' (forall a. JsToDoc a => a -> Doc
jsToDoc JStat
y)
    jsToDoc (DeclStat Ident
x Maybe JLocalType
t) = Text -> Doc
text Text
"var" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc Ident
x 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
<+> 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" forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
p) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (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' (forall a. JsToDoc a => a -> Doc
jsToDoc JStat
b)) Doc -> Doc -> Doc
$+$ Text -> Doc
text Text
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
p)
    jsToDoc (UnsatBlock IdentSupply JStat
e) = forall a. JsToDoc a => a -> Doc
jsToDoc forall a b. (a -> b) -> a -> b
$ forall a. IdentSupply a -> a
sat_ IdentSupply JStat
e

    jsToDoc (BreakStat Maybe String
l) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Doc
text Text
"break") ((Doc -> Doc -> Doc
(<+>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Doc
text) Text
"break" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) Maybe String
l
    jsToDoc (ContinueStat Maybe String
l) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Doc
text Text
"continue") ((Doc -> Doc -> Doc
(<+>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Doc
text) Text
"continue" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) Maybe String
l
    jsToDoc (LabelStat String
l JStat
s) = Text -> Doc
text (String -> Text
T.pack String
l) 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 forall a b. (a -> b) -> a -> b
$ forall {a}. JsToDoc a => [a] -> [Doc]
interSemi forall a b. (a -> b) -> a -> b
$ [JStat] -> [JStat]
flattenBlocks [JStat]
ss
          printBS JStat
x = forall a. JsToDoc a => a -> Doc
jsToDoc JStat
x
          interSemi :: [a] -> [Doc]
interSemi [a
x] = [forall a. JsToDoc a => a -> Doc
jsToDoc a
x]
          interSemi [] = []
          interSemi (a
x:[a]
xs) = (forall a. JsToDoc a => a -> Doc
jsToDoc a
x forall a. Semigroup a => a -> a -> a
<> Doc
semi) 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 forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (Text -> Doc
text Text
"var" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"in" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (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 (forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' Doc
cases
        where l' :: [Doc]
l' = forall a b. (a -> b) -> [a] -> [b]
map (\(JExpr
c,JStat
s) -> (Text -> Doc
text Text
"case" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
c) forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
':') Doc -> Doc -> Doc
$$$ (forall a. JsToDoc a => a -> Doc
jsToDoc JStat
s)) [(JExpr, JStat)]
l forall a. [a] -> [a] -> [a]
++ [Text -> Doc
text Text
"default:" Doc -> Doc -> 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
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e
    jsToDoc (ApplStat JExpr
e [JExpr]
es) = forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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' (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 forall a. Eq a => a -> a -> Bool
== [JStat] -> JStat
BlockStat [] = Doc
PP.empty
                      | Bool
otherwise = Text -> Doc
text Text
"catch" forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (forall a. JsToDoc a => a -> Doc
jsToDoc JStat
s1)
              mbFinally :: Doc
mbFinally | JStat
s2 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' (forall a. JsToDoc a => a -> Doc
jsToDoc JStat
s2)
    jsToDoc (AssignStat JExpr
i JExpr
x) = forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
i Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x
    jsToDoc (PPostStat Bool
isPre String
op JExpr
x)
        | Bool
isPre = Text -> Doc
text (String -> Text
T.pack String
op) forall a. Semigroup a => a -> a -> a
<> JExpr -> Doc
optParens JExpr
x
        | Bool
otherwise = JExpr -> Doc
optParens JExpr
x forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (String -> Text
T.pack String
op)
    jsToDoc (AntiStat String
s) = Text -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"`(" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
")`"
    jsToDoc (ForeignStat Ident
i JLocalType
t) = Text -> Doc
text Text
"//foriegn" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"::" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JLocalType
t
    jsToDoc (BlockStat [JStat]
xs) = 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 forall a. [a] -> [a] -> [a]
++ [JStat] -> [JStat]
flattenBlocks [JStat]
ys
flattenBlocks (JStat
y:[JStat]
ys) = JStat
y 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
_ String
_ JExpr
_) -> Doc -> Doc
parens (forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x)
                JExpr
_ -> forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x

instance JsToDoc JExpr where
    jsToDoc :: JExpr -> Doc
jsToDoc (ValExpr JVal
x) = forall a. JsToDoc a => a -> Doc
jsToDoc JVal
x
    jsToDoc (SelExpr JExpr
x Ident
y) = [Doc] -> Doc
cat [forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'.', forall a. JsToDoc a => a -> Doc
jsToDoc Ident
y]
    jsToDoc (IdxExpr JExpr
x JExpr
y) = forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
brackets (forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
y)
    jsToDoc (IfExpr JExpr
x JExpr
y JExpr
z) = Doc -> Doc
parens (forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
y Doc -> Doc -> Doc
<+> Char -> Doc
char Char
':' Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
z)
    jsToDoc (InfixExpr String
op JExpr
x JExpr
y) = Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep [forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
x, Text -> Doc
text (String -> Text
T.pack String
op'), forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
y]
        where op' :: String
op' | String
op forall a. Eq a => a -> a -> Bool
== String
"++" = String
"+"
                  | Bool
otherwise = String
op

    jsToDoc (PPostExpr Bool
isPre String
op JExpr
x)
        | Bool
isPre = Text -> Doc
text (String -> Text
T.pack String
op) forall a. Semigroup a => a -> a -> a
<> JExpr -> Doc
optParens JExpr
x
        | Bool
otherwise = JExpr -> Doc
optParens JExpr
x forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text (String -> Text
T.pack String
op)

    jsToDoc (ApplExpr JExpr
je [JExpr]
xs) = forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
je forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. JsToDoc a => a -> Doc
jsToDoc [JExpr]
xs)
    jsToDoc (NewExpr JExpr
e) = Text -> Doc
text Text
"new" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
e
    jsToDoc (AntiExpr String
s) = Text -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"`(" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
")`"
    jsToDoc (TypeExpr Bool
b JExpr
e JLocalType
t)  = Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ 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
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JLocalType
t Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"*/"
    jsToDoc (UnsatExpr IdentSupply JExpr
e) = forall a. JsToDoc a => a -> Doc
jsToDoc forall a b. (a -> b) -> a -> b
$ forall a. IdentSupply a -> a
sat_ IdentSupply JExpr
e

instance JsToDoc JVal where
    jsToDoc :: JVal -> Doc
jsToDoc (JVar Ident
i) = forall a. JsToDoc a => a -> Doc
jsToDoc Ident
i
    jsToDoc (JList [JExpr]
xs) = Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 String
s) = Text -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"\""forall a. [a] -> [a] -> [a]
++ShowS
encodeJson String
sforall a. [a] -> [a] -> [a]
++String
"\""
    jsToDoc (JRegEx String
s) = Text -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"/"forall a. [a] -> [a] -> [a]
++String
sforall a. [a] -> [a] -> [a]
++String
"/"
    jsToDoc (JHash Map String JExpr
m)
            | forall k a. Map k a -> Bool
M.null Map String JExpr
m = Text -> Doc
text Text
"{}"
            | Bool
otherwise = Doc -> Doc
braceNest forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,JExpr
y) -> Doc -> Doc
squotes (Text -> Doc
text (String -> Text
T.pack String
x)) forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JExpr
y) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map String JExpr
m
    jsToDoc (JFunc [Ident]
is JStat
b) = Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ Text -> Doc
text Text
"function" forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. JsToDoc a => a -> Doc
jsToDoc forall a b. (a -> b) -> a -> b
$ [Ident]
is) Doc -> Doc -> Doc
$$ Doc -> Doc
braceNest' (forall a. JsToDoc a => a -> Doc
jsToDoc JStat
b)
    jsToDoc (UnsatVal IdentSupply JVal
f) = forall a. JsToDoc a => a -> Doc
jsToDoc forall a b. (a -> b) -> a -> b
$ forall a. IdentSupply a -> a
sat_ IdentSupply JVal
f

instance JsToDoc Ident where
    jsToDoc :: Ident -> Doc
jsToDoc (StrI String
s) = Text -> Doc
text (String -> Text
T.pack String
s)

instance JsToDoc [JExpr] where
    jsToDoc :: [JExpr] -> Doc
jsToDoc = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Semigroup a => a -> a -> a
<> Doc
semi) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. JsToDoc a => a -> Doc
jsToDoc)

instance JsToDoc [JStat] where
    jsToDoc :: [JStat] -> Doc
jsToDoc = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Semigroup a => a -> a -> a
<> Doc
semi) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => (Maybe String, a) -> Doc
ppRef [VarRef]
vars)) forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
"." Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JType
t
    jsToDoc (JTFunc [JType]
args JType
ret) = [Doc] -> Doc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (Text -> Doc
text Text
" ->") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map JType -> Doc
ppType forall a b. (a -> b) -> a -> b
$ [JType]
args' forall a. [a] -> [a] -> [a]
++ [JType
ret]
        where args' :: [JType]
args'
               | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [JType]
args = [JType
JTStat]
               | Bool
otherwise = [JType]
args
    jsToDoc (JTList JType
t) = Doc -> Doc
brackets forall a b. (a -> b) -> a -> b
$ 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 String JType
mp) = Doc -> Doc
braces ([Doc] -> Doc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,JType
y) -> Text -> Doc
text (String -> Text
T.pack String
x) Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"::" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JType
y) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map String JType
mp) Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. JsToDoc a => a -> Doc
jsToDoc JType
t forall a. Semigroup a => a -> a -> a
<> Text -> Doc
text Text
"]"
    jsToDoc (JTFree VarRef
ref) = forall a. Show a => (Maybe String, a) -> Doc
ppRef VarRef
ref
    jsToDoc (JTRigid VarRef
ref Set Constraint
cs) = Text -> Doc
text Text
"[" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => (Maybe String, a) -> Doc
ppRef VarRef
ref 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) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Doc
text Text
"") (Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"=> ") (forall a. Show a => [((Maybe String, a), Constraint)] -> Maybe Doc
ppConstraintList [(VarRef, Constraint)]
cs) forall a. Semigroup a => a -> a -> a
<> forall a. JsToDoc a => a -> Doc
jsToDoc JType
t

ppConstraintList :: Show a => [((Maybe String, a), Constraint)] -> Maybe Doc
ppConstraintList :: forall a. Show a => [((Maybe String, a), Constraint)] -> Maybe Doc
ppConstraintList [((Maybe String, a), Constraint)]
cs
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((Maybe String, a), Constraint)]
cs = forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => ((Maybe String, a), Constraint) -> Doc
go [((Maybe String, a), Constraint)]
cs
    where
      go :: ((Maybe String, a), Constraint) -> Doc
go ((Maybe String, a)
vr,Sub   JType
t') = forall a. Show a => (Maybe String, a) -> Doc
ppRef (Maybe String, a)
vr   Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"<:" Doc -> Doc -> Doc
<+> forall a. JsToDoc a => a -> Doc
jsToDoc JType
t'
      go ((Maybe String, a)
vr,Super JType
t') = forall a. JsToDoc a => a -> Doc
jsToDoc JType
t' Doc -> Doc -> Doc
<+> Text -> Doc
text Text
"<:" Doc -> Doc -> Doc
<+> forall a. Show a => (Maybe String, a) -> Doc
ppRef (Maybe String, a)
vr

ppRef :: Show a => (Maybe String, a) -> Doc
ppRef :: forall a. Show a => (Maybe String, a) -> Doc
ppRef (Just String
n,a
_) = Text -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
n
ppRef (Maybe String
_,a
i) = Text -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"t_"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show a
i

ppType :: JType -> Doc
ppType :: JType -> Doc
ppType x :: JType
x@(JTFunc [JType]
_ JType
_) = Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ forall a. JsToDoc a => a -> Doc
jsToDoc JType
x
ppType x :: JType
x@(JTMap JType
_) = Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ forall a. JsToDoc a => a -> Doc
jsToDoc JType
x
ppType JType
x = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJExpr a => a -> JExpr
toJExpr

instance ToJExpr a => ToJExpr [a] where
    toJExpr :: [a] -> JExpr
toJExpr = forall a. ToJExpr a => [a] -> JExpr
toJExprFromList

instance ToJExpr JExpr where
    toJExpr :: JExpr -> JExpr
toJExpr = forall a. a -> a
id

instance ToJExpr () where
    toJExpr :: () -> JExpr
toJExpr ()
_ = JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ [JExpr] -> JVal
JList []

instance ToJExpr Bool where
    toJExpr :: Bool -> JExpr
toJExpr Bool
True  = String -> JExpr
jsv String
"true"
    toJExpr Bool
False = String -> JExpr
jsv String
"false"

instance ToJExpr JVal where
    toJExpr :: JVal -> JExpr
toJExpr = JVal -> JExpr
ValExpr

instance ToJExpr a => ToJExpr (M.Map String a) where
    toJExpr :: Map String a -> JExpr
toJExpr = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String JExpr -> JVal
JHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall a. ToJExpr a => a -> JExpr
toJExpr

instance ToJExpr Double where
    toJExpr :: Double -> JExpr
toJExpr = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. SaneDouble -> JVal
JDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> SaneDouble
SaneDouble

instance ToJExpr Int where
    toJExpr :: Int -> JExpr
toJExpr = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> JVal
JInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance ToJExpr Integer where
    toJExpr :: Integer -> JExpr
toJExpr = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> JVal
JInt

instance ToJExpr Char where
    toJExpr :: Char -> JExpr
toJExpr = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JVal
JStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])
    toJExprFromList :: String -> JExpr
toJExprFromList = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JVal
JStr
--        where escQuotes = tailDef "" . initDef "" . show

instance ToJExpr TS.Text where
    toJExpr :: Text -> JExpr
toJExpr Text
t = forall a. ToJExpr a => a -> JExpr
toJExpr (Text -> String
TS.unpack Text
t)

instance ToJExpr T.Text where
    toJExpr :: Text -> JExpr
toJExpr Text
t = forall a. ToJExpr a => a -> JExpr
toJExpr (Text -> String
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList forall a b. (a -> b) -> a -> b
$ [forall a. ToJExpr a => a -> JExpr
toJExpr a
a, 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList forall a b. (a -> b) -> a -> b
$ [forall a. ToJExpr a => a -> JExpr
toJExpr a
a, forall a. ToJExpr a => a -> JExpr
toJExpr b
b, 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList forall a b. (a -> b) -> a -> b
$ [forall a. ToJExpr a => a -> JExpr
toJExpr a
a, forall a. ToJExpr a => a -> JExpr
toJExpr b
b, forall a. ToJExpr a => a -> JExpr
toJExpr c
c, 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList forall a b. (a -> b) -> a -> b
$ [forall a. ToJExpr a => a -> JExpr
toJExpr a
a, forall a. ToJExpr a => a -> JExpr
toJExpr b
b, forall a. ToJExpr a => a -> JExpr
toJExpr c
c, forall a. ToJExpr a => a -> JExpr
toJExpr d
d, 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JExpr] -> JVal
JList forall a b. (a -> b) -> a -> b
$ [forall a. ToJExpr a => a -> JExpr
toJExpr a
a, forall a. ToJExpr a => a -> JExpr
toJExpr b
b, forall a. ToJExpr a => a -> JExpr
toJExpr c
c, forall a. ToJExpr a => a -> JExpr
toJExpr d
d, forall a. ToJExpr a => a -> JExpr
toJExpr e
e, forall a. ToJExpr a => a -> JExpr
toJExpr f
f]

instance Num JExpr where
    fromInteger :: Integer -> JExpr
fromInteger = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> JVal
JInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
    JExpr
x + :: JExpr -> JExpr -> JExpr
+ JExpr
y = String -> JExpr -> JExpr -> JExpr
InfixExpr String
"+" JExpr
x JExpr
y
    JExpr
x - :: JExpr -> JExpr -> JExpr
- JExpr
y = String -> JExpr -> JExpr -> JExpr
InfixExpr String
"-" JExpr
x JExpr
y
    JExpr
x * :: JExpr -> JExpr -> JExpr
* JExpr
y = String -> JExpr -> JExpr -> JExpr
InfixExpr String
"*" JExpr
x JExpr
y
    abs :: JExpr -> JExpr
abs JExpr
x = JExpr -> [JExpr] -> JExpr
ApplExpr (String -> JExpr
jsv String
"Math.abs") [JExpr
x]
    signum :: JExpr -> JExpr
signum JExpr
x = JExpr -> JExpr -> JExpr -> JExpr
IfExpr (String -> JExpr -> JExpr -> JExpr
InfixExpr String
">" JExpr
x JExpr
0) JExpr
1 (JExpr -> JExpr -> JExpr -> JExpr
IfExpr (String -> JExpr -> JExpr -> JExpr
InfixExpr String
"==" 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. ToSat a => a -> JExpr
jLam a
f = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentSupply JVal -> JVal
UnsatVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ do
           (JStat
block,[Ident]
is) <- forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
           forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall a. ToSat a => a -> JStat
jVar a
f = IdentSupply JStat -> JStat
UnsatBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ do
           (JStat
block, [Ident]
is) <- forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
           let addDecls :: JStat -> JStat
addDecls (BlockStat [JStat]
ss) =
                  [JStat] -> JStat
BlockStat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Ident
x -> Ident -> Maybe JLocalType -> JStat
DeclStat Ident
x forall a. Maybe a
Nothing) [Ident]
is forall a. [a] -> [a] -> [a]
++ [JStat]
ss
               addDecls JStat
x = JStat
x
           forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall a. ToSat a => a -> Maybe JLocalType -> JStat
jVarTy a
f Maybe JLocalType
t = IdentSupply JStat -> JStat
UnsatBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ do
           (JStat
block, [Ident]
is) <- forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
           let addDecls :: JStat -> JStat
addDecls (BlockStat [JStat]
ss) =
                  [JStat] -> JStat
BlockStat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Ident
x -> Ident -> Maybe JLocalType -> JStat
DeclStat Ident
x Maybe JLocalType
t) [Ident]
is forall a. [a] -> [a] -> [a]
++ [JStat]
ss
               addDecls JStat
x = JStat
x
           forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall a. ToSat a => JExpr -> (JExpr -> a) -> JStat
jForIn JExpr
e JExpr -> a
f = IdentSupply JStat -> JStat
UnsatBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ do
               (JStat
block, [Ident]
is) <- forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JExpr -> a
f []
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
False (forall a. HasCallStack => String -> [a] -> a
headNote String
"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 :: forall a. ToSat a => JExpr -> (JExpr -> a) -> JStat
jForEachIn JExpr
e JExpr -> a
f = IdentSupply JStat -> JStat
UnsatBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ do
               (JStat
block, [Ident]
is) <- forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ JExpr -> a
f []
               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Ident -> JExpr -> JStat -> JStat
ForInStat Bool
True (forall a. HasCallStack => String -> [a] -> a
headNote String
"jForIn" [Ident]
is) JExpr
e JStat
block

jTryCatchFinally :: (ToSat a) => JStat -> a -> JStat -> JStat
jTryCatchFinally :: forall a. ToSat a => JStat -> a -> JStat -> JStat
jTryCatchFinally JStat
s a
f JStat
s2 = IdentSupply JStat -> JStat
UnsatBlock forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. State [Ident] a -> IdentSupply a
IS forall a b. (a -> b) -> a -> b
$ do
                     (JStat
block, [Ident]
is) <- forall a. IdentSupply a -> State [Ident] a
runIdentSupply forall a b. (a -> b) -> a -> b
$ forall a. ToSat a => a -> [Ident] -> IdentSupply (JStat, [Ident])
toSat_ a
f []
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ JStat -> Ident -> JStat -> JStat -> JStat
TryStat JStat
s (forall a. HasCallStack => String -> [a] -> a
headNote String
"jTryCatch" [Ident]
is) JStat
block JStat
s2

jsv :: String -> JExpr
jsv :: String -> JExpr
jsv = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> JVal
JVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Ident
StrI

jFor :: (ToJExpr a, ToStat b) => JStat -> a -> JStat -> b -> JStat
jFor :: forall a b.
(ToJExpr a, ToStat b) =>
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 (forall a. ToJExpr a => a -> JExpr
toJExpr a
p) JStat
b']
    where b' :: JStat
b' = case forall a. ToStat a => a -> JStat
toStat b
b of
                 BlockStat [JStat]
xs -> [JStat] -> JStat
BlockStat forall a b. (a -> b) -> a -> b
$ [JStat]
xs forall a. [a] -> [a] -> [a]
++ [JStat
after]
                 JStat
x -> [JStat] -> JStat
BlockStat [JStat
x,JStat
after]

jhEmpty :: M.Map String JExpr
jhEmpty :: Map String JExpr
jhEmpty = forall k a. Map k a
M.empty

jhSingle :: ToJExpr a => String -> a -> M.Map String JExpr
jhSingle :: forall a. ToJExpr a => String -> a -> Map String JExpr
jhSingle String
k a
v = forall a.
ToJExpr a =>
String -> a -> Map String JExpr -> Map String JExpr
jhAdd String
k a
v forall a b. (a -> b) -> a -> b
$ Map String JExpr
jhEmpty

jhAdd :: ToJExpr a => String -> a -> M.Map String JExpr -> M.Map String JExpr
jhAdd :: forall a.
ToJExpr a =>
String -> a -> Map String JExpr -> Map String JExpr
jhAdd  String
k a
v Map String JExpr
m = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
k (forall a. ToJExpr a => a -> JExpr
toJExpr a
v) Map String JExpr
m

jhFromList :: [(String, JExpr)] -> JVal
jhFromList :: [(String, JExpr)] -> JVal
jhFromList = Map String JExpr -> JVal
JHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList

jtFromList :: JType -> [(String, JType)] -> JType
jtFromList :: JType -> [(String, JType)] -> JType
jtFromList JType
t [(String, JType)]
y = JType -> Map String JType -> JType
JTRecord JType
t forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, 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 forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar forall a b. (a -> b) -> a -> b
$ String -> Ident
StrI String
"null"
    toJExpr (Bool Bool
b)         = JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Ident -> JVal
JVar forall a b. (a -> b) -> a -> b
$ String -> Ident
StrI forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (forall a. Show a => a -> String
show Bool
b)
    toJExpr (Number Scientific
n)       = JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ SaneDouble -> JVal
JDouble forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac Scientific
n
    toJExpr (String Text
s)       = JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ String -> JVal
JStr forall a b. (a -> b) -> a -> b
$ Text -> String
TS.unpack Text
s
    toJExpr (Array Array
vs)       = JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ [JExpr] -> JVal
JList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJExpr a => a -> JExpr
toJExpr forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Array
vs
#if MIN_VERSION_aeson (2,0,0)
    toJExpr (Object Object
obj)     = JVal -> JExpr
ValExpr forall a b. (a -> b) -> a -> b
$ Map String JExpr -> JVal
JHash forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Key -> String
KM.toString forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. ToJExpr a => a -> JExpr
toJExpr) forall a b. (a -> b) -> a -> b
$ 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 :: ShowS
encodeJson = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
encodeJsonChar

encodeJsonChar :: Char -> String
encodeJsonChar :: Char -> String
encodeJsonChar Char
'/'  = String
"\\/"
encodeJsonChar Char
'\b' = String
"\\b"
encodeJsonChar Char
'\f' = String
"\\f"
encodeJsonChar Char
'\n' = String
"\\n"
encodeJsonChar Char
'\r' = String
"\\r"
encodeJsonChar Char
'\t' = String
"\\t"
encodeJsonChar Char
'"' = String
"\\\""
encodeJsonChar Char
'\\' = String
"\\\\"
encodeJsonChar Char
c
    | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
isControl Char
c = [Char
c]
    | Char
c forall a. Ord a => a -> a -> Bool
< Char
'\x10'   = Char
'\\' forall a. a -> [a] -> [a]
: Char
'u' forall a. a -> [a] -> [a]
: Char
'0' forall a. a -> [a] -> [a]
: Char
'0' forall a. a -> [a] -> [a]
: Char
'0' forall a. a -> [a] -> [a]
: String
hexxs
    | Char
c forall a. Ord a => a -> a -> Bool
< Char
'\x100'  = Char
'\\' forall a. a -> [a] -> [a]
: Char
'u' forall a. a -> [a] -> [a]
: Char
'0' forall a. a -> [a] -> [a]
: Char
'0' forall a. a -> [a] -> [a]
: String
hexxs
    | Char
c forall a. Ord a => a -> a -> Bool
< Char
'\x1000' = Char
'\\' forall a. a -> [a] -> [a]
: Char
'u' forall a. a -> [a] -> [a]
: Char
'0' forall a. a -> [a] -> [a]
: String
hexxs
    where hexxs :: String
hexxs = forall a. (Integral a, Show a) => a -> ShowS
showHex (forall a. Enum a => a -> Int
fromEnum Char
c) String
"" -- FIXME
encodeJsonChar Char
c = [Char
c]