{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE TupleSections     #-}

-- | Optimizing the outputted JavaScript(-ish) AST.

module Fay.Compiler.Optimizer where

import           Fay.Compiler.Prelude

import           Fay.Compiler.Misc
import           Fay.Types

import           Control.Monad.State             (State, modify, runState)
import           Control.Monad.Writer            (runWriter, tell)
import qualified Fay.Exts.NoAnnotation           as N
import           Language.Haskell.Exts hiding (app, name, op)

-- | The arity of a function. Arity here is defined to be the number
-- of arguments that can be directly uncurried from a curried lambda
-- abstraction. So \x y z -> if x then (\a -> a) else (\a -> a) has an
-- arity of 3, not 4.
type FuncArity = (N.QName,Int)

-- | Optimize monad.
type Optimize = State OptState

-- | State.
data OptState = OptState
  { OptState -> [JsStmt]
optStmts   :: [JsStmt]
  , OptState -> [QName]
optUncurry :: [N.QName]
  }

-- | Run an optimizer, which may output additional statements.
runOptimizer :: ([JsStmt] -> Optimize [JsStmt]) -> [JsStmt] -> [JsStmt]
runOptimizer :: ([JsStmt] -> Optimize [JsStmt]) -> [JsStmt] -> [JsStmt]
runOptimizer [JsStmt] -> Optimize [JsStmt]
optimizer [JsStmt]
stmts =
  let ([JsStmt]
newstmts,OptState [JsStmt]
_ [QName]
uncurried) = (Optimize [JsStmt] -> OptState -> ([JsStmt], OptState))
-> OptState -> Optimize [JsStmt] -> ([JsStmt], OptState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Optimize [JsStmt] -> OptState -> ([JsStmt], OptState)
forall s a. State s a -> s -> (a, s)
runState OptState
st (Optimize [JsStmt] -> ([JsStmt], OptState))
-> Optimize [JsStmt] -> ([JsStmt], OptState)
forall a b. (a -> b) -> a -> b
$ [JsStmt] -> Optimize [JsStmt]
optimizer [JsStmt]
stmts
  in [JsStmt]
newstmts [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ ([JsStmt] -> [JsStmt]
tco ([JsStmt] -> [JsStmt])
-> ([QName] -> [JsStmt]) -> [QName] -> [JsStmt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QName -> Maybe JsStmt) -> [QName] -> [JsStmt]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([JsStmt] -> QName -> Maybe JsStmt
uncurryBinding [JsStmt]
newstmts) ([QName] -> [JsStmt]) -> [QName] -> [JsStmt]
forall a b. (a -> b) -> a -> b
$ [QName] -> [QName]
forall a. Eq a => [a] -> [a]
nub [QName]
uncurried)
  where st :: OptState
st = [JsStmt] -> [QName] -> OptState
OptState [JsStmt]
stmts []

-- | Inline x >> y to x;y in the JS output.
inlineMonad :: [JsStmt] -> [JsStmt]
inlineMonad :: [JsStmt] -> [JsStmt]
inlineMonad = (JsStmt -> JsStmt) -> [JsStmt] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map JsStmt -> JsStmt
go where
  go :: JsStmt -> JsStmt
go JsStmt
stmt = case JsStmt
stmt of
    JsVar JsName
name JsExp
exp          -> JsName -> JsExp -> JsStmt
JsVar JsName
name (JsExp -> JsExp
inline JsExp
exp)
    JsIf JsExp
exp [JsStmt]
stmts [JsStmt]
stmts'   -> JsExp -> [JsStmt] -> [JsStmt] -> JsStmt
JsIf (JsExp -> JsExp
inline JsExp
exp) ((JsStmt -> JsStmt) -> [JsStmt] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map JsStmt -> JsStmt
go [JsStmt]
stmts) ((JsStmt -> JsStmt) -> [JsStmt] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map JsStmt -> JsStmt
go [JsStmt]
stmts')
    JsEarlyReturn JsExp
exp       -> JsExp -> JsStmt
JsEarlyReturn (JsExp -> JsExp
inline JsExp
exp)
    JsThrow JsExp
exp             -> JsExp -> JsStmt
JsThrow (JsExp -> JsExp
inline JsExp
exp)
    JsWhile JsExp
exp [JsStmt]
stmts       -> JsExp -> [JsStmt] -> JsStmt
JsWhile (JsExp -> JsExp
inline JsExp
exp) ((JsStmt -> JsStmt) -> [JsStmt] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map JsStmt -> JsStmt
go [JsStmt]
stmts)
    JsUpdate JsName
name JsExp
exp       -> JsName -> JsExp -> JsStmt
JsUpdate JsName
name (JsExp -> JsExp
inline JsExp
exp)
    JsSetProp JsName
a JsName
b JsExp
exp       -> JsName -> JsName -> JsExp -> JsStmt
JsSetProp JsName
a JsName
b (JsExp -> JsExp
inline JsExp
exp)
    JsSetQName Maybe SrcSpan
s QName
a JsExp
exp      -> Maybe SrcSpan -> QName -> JsExp -> JsStmt
JsSetQName Maybe SrcSpan
s QName
a (JsExp -> JsExp
inline JsExp
exp)
    JsSetModule ModulePath
a JsExp
exp       -> ModulePath -> JsExp -> JsStmt
JsSetModule ModulePath
a (JsExp -> JsExp
inline JsExp
exp)
    JsSetConstructor QName
a JsExp
exp  -> QName -> JsExp -> JsStmt
JsSetConstructor QName
a (JsExp -> JsExp
inline JsExp
exp)
    JsSetPropExtern JsName
a JsName
b JsExp
exp -> JsName -> JsName -> JsExp -> JsStmt
JsSetPropExtern JsName
a JsName
b (JsExp -> JsExp
inline JsExp
exp)
    JsStmt
JsContinue              -> JsStmt
JsContinue
    JsBlock [JsStmt]
stmts           -> [JsStmt] -> JsStmt
JsBlock ((JsStmt -> JsStmt) -> [JsStmt] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map JsStmt -> JsStmt
go [JsStmt]
stmts)
    JsExpStmt JsExp
exp           -> JsExp -> JsStmt
JsExpStmt (JsExp -> JsExp
inline JsExp
exp)

  inline :: JsExp -> JsExp
inline JsExp
expr = case JsExp
expr of
    -- Optimizations
    JsApp JsExp
op [JsExp]
args -> JsExp -> Maybe JsExp -> JsExp
forall a. a -> Maybe a -> a
fromMaybe (JsExp -> [JsExp] -> JsExp
JsApp (JsExp -> JsExp
inline JsExp
op) ([JsExp] -> JsExp) -> [JsExp] -> JsExp
forall a b. (a -> b) -> a -> b
$ (JsExp -> JsExp) -> [JsExp] -> [JsExp]
forall a b. (a -> b) -> [a] -> [b]
map JsExp -> JsExp
inline [JsExp]
args) (JsExp -> Maybe JsExp
flatten JsExp
expr)

    -- Plumbing
    JsFun Maybe JsName
nm [JsName]
names [JsStmt]
stmts Maybe JsExp
mexp        -> Maybe JsName -> [JsName] -> [JsStmt] -> Maybe JsExp -> JsExp
JsFun Maybe JsName
nm [JsName]
names ((JsStmt -> JsStmt) -> [JsStmt] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map JsStmt -> JsStmt
go [JsStmt]
stmts) ((JsExp -> JsExp) -> Maybe JsExp -> Maybe JsExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsExp -> JsExp
inline Maybe JsExp
mexp)

    JsNegApp JsExp
exp                     -> JsExp -> JsExp
JsNegApp (JsExp -> JsExp
inline JsExp
exp)
    JsTernaryIf JsExp
exp1 JsExp
exp2 JsExp
exp3       -> JsExp -> JsExp -> JsExp -> JsExp
JsTernaryIf (JsExp -> JsExp
inline JsExp
exp1) (JsExp -> JsExp
inline JsExp
exp2) (JsExp -> JsExp
inline JsExp
exp3)
    JsParen JsExp
exp                      -> JsExp -> JsExp
JsParen (JsExp -> JsExp
inline JsExp
exp)
    JsGetProp JsExp
exp JsName
name               -> JsExp -> JsName -> JsExp
JsGetProp (JsExp -> JsExp
inline JsExp
exp) JsName
name
    JsLookup JsExp
exp JsExp
exp2                -> JsExp -> JsExp -> JsExp
JsLookup (JsExp -> JsExp
inline JsExp
exp) (JsExp -> JsExp
inline JsExp
exp2)
    JsUpdateProp JsExp
exp JsName
name JsExp
exp2       -> JsExp -> JsName -> JsExp -> JsExp
JsUpdateProp (JsExp -> JsExp
inline JsExp
exp) JsName
name (JsExp -> JsExp
inline JsExp
exp2)
    JsGetPropExtern JsExp
exp String
string       -> JsExp -> String -> JsExp
JsGetPropExtern (JsExp -> JsExp
inline JsExp
exp) String
string
    JsUpdatePropExtern JsExp
exp JsName
name JsExp
exp2 -> JsExp -> JsName -> JsExp -> JsExp
JsUpdatePropExtern (JsExp -> JsExp
inline JsExp
exp) JsName
name (JsExp -> JsExp
inline JsExp
exp2)
    JsList [JsExp]
exps                      -> [JsExp] -> JsExp
JsList ((JsExp -> JsExp) -> [JsExp] -> [JsExp]
forall a b. (a -> b) -> [a] -> [b]
map JsExp -> JsExp
inline [JsExp]
exps)
    JsNew JsName
name [JsExp]
exps                  -> JsName -> [JsExp] -> JsExp
JsNew JsName
name ((JsExp -> JsExp) -> [JsExp] -> [JsExp]
forall a b. (a -> b) -> [a] -> [b]
map JsExp -> JsExp
inline [JsExp]
exps)
    JsThrowExp JsExp
exp                   -> JsExp -> JsExp
JsThrowExp (JsExp -> JsExp
inline JsExp
exp)
    JsInstanceOf JsExp
exp JsName
name            -> JsExp -> JsName -> JsExp
JsInstanceOf (JsExp -> JsExp
inline JsExp
exp) JsName
name
    JsIndex Int
i JsExp
exp                    -> Int -> JsExp -> JsExp
JsIndex Int
i (JsExp -> JsExp
inline JsExp
exp)
    JsEq JsExp
exp JsExp
exp2                    -> JsExp -> JsExp -> JsExp
JsEq (JsExp -> JsExp
inline JsExp
exp) (JsExp -> JsExp
inline JsExp
exp2)
    JsNeq JsExp
exp JsExp
exp2                   -> JsExp -> JsExp -> JsExp
JsNeq (JsExp -> JsExp
inline JsExp
exp) (JsExp -> JsExp
inline JsExp
exp2)
    JsInfix String
string JsExp
exp JsExp
exp2          -> String -> JsExp -> JsExp -> JsExp
JsInfix String
string (JsExp -> JsExp
inline JsExp
exp) (JsExp -> JsExp
inline JsExp
exp2)
    JsObj [(String, JsExp)]
keyvals                    -> [(String, JsExp)] -> JsExp
JsObj [(String, JsExp)]
keyvals
    JsExp
rest                             -> JsExp
rest

-- | Flatten a a>>(b>>c) to [a,b,c].
flatten :: JsExp -> Maybe JsExp
flatten :: JsExp -> Maybe JsExp
flatten JsExp
exp = case JsExp -> Maybe [JsExp]
collect JsExp
exp of
  Just (stmts :: [JsExp]
stmts@(JsExp
_:JsExp
_:[JsExp]
_)) -> let s :: [JsExp]
s = [JsExp] -> [JsExp]
forall a. [a] -> [a]
reverse [JsExp]
stmts
                          in JsExp -> Maybe JsExp
forall a. a -> Maybe a
Just (JsExp -> Maybe JsExp) -> JsExp -> Maybe JsExp
forall a b. (a -> b) -> a -> b
$ JsExp -> JsExp
thunk ([JsExp] -> JsExp
JsSeq ((JsExp -> JsExp) -> [JsExp] -> [JsExp]
forall a b. (a -> b) -> [a] -> [b]
map JsExp -> JsExp
force ([JsExp] -> [JsExp]
forall a. [a] -> [a]
init [JsExp]
s) [JsExp] -> [JsExp] -> [JsExp]
forall a. [a] -> [a] -> [a]
++ [[JsExp] -> JsExp
forall a. [a] -> a
last [JsExp]
s]))
  Maybe [JsExp]
_ -> Maybe JsExp
forall a. Maybe a
Nothing

-- | Try to collect nested a>>(b>>c).
collect :: JsExp -> Maybe [JsExp]
collect :: JsExp -> Maybe [JsExp]
collect JsExp
exp = case JsExp
exp of
  JsApp JsExp
op [JsExp]
args | JsExp -> Bool
isThen JsExp
op ->
    case [JsExp]
args of
      [JsExp
rest,JsExp
x] -> (JsExp
x JsExp -> [JsExp] -> [JsExp]
forall a. a -> [a] -> [a]
:) ([JsExp] -> [JsExp]) -> Maybe [JsExp] -> Maybe [JsExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Maybe [JsExp]
collect JsExp
rest
      [JsExp
x]  -> [JsExp] -> Maybe [JsExp]
forall (m :: * -> *) a. Monad m => a -> m a
return [JsExp
x]
      [JsExp]
_ -> Maybe [JsExp]
forall a. Maybe a
Nothing
  JsExp
_ -> [JsExp] -> Maybe [JsExp]
forall (m :: * -> *) a. Monad m => a -> m a
return [JsExp
exp]

  where
    isThen :: JsExp -> Bool
isThen (JsName (JsNameVar (Qual ()
_ (ModuleName ()
_ String
m) (Ident ()
_ String
n)))) = String
m String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Fay$" Bool -> Bool -> Bool
&& String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"then$uncurried"
    isThen JsExp
_ = Bool
False


-- | Perform any top-level cross-module optimizations and GO DEEP to
-- optimize further.
optimizeToplevel :: [JsStmt] -> Optimize [JsStmt]
optimizeToplevel :: [JsStmt] -> Optimize [JsStmt]
optimizeToplevel = [JsStmt] -> Optimize [JsStmt]
stripAndUncurry

-- | Perform tail-call optimization.
tco :: [JsStmt] -> [JsStmt]
tco :: [JsStmt] -> [JsStmt]
tco = (JsStmt -> JsStmt) -> [JsStmt] -> [JsStmt]
forall a b. (a -> b) -> [a] -> [b]
map JsStmt -> JsStmt
inStmt where
  inStmt :: JsStmt -> JsStmt
inStmt JsStmt
stmt = case JsStmt
stmt of
    JsVar JsName
name JsExp
exp -> JsName -> JsExp -> JsStmt
JsVar JsName
name (JsName -> JsExp -> JsExp
inject JsName
name JsExp
exp)
    JsSetQName Maybe SrcSpan
l QName
name JsExp
exp -> Maybe SrcSpan -> QName -> JsExp -> JsStmt
JsSetQName Maybe SrcSpan
l QName
name (JsName -> JsExp -> JsExp
inject (QName -> JsName
JsNameVar QName
name) JsExp
exp)
    JsStmt
e -> JsStmt
e
  inject :: JsName -> JsExp -> JsExp
inject JsName
name JsExp
exp = case JsExp
exp of
    JsFun Maybe JsName
nm [JsName]
params [] (Just (JsNew JsName
JsThunk [JsFun Maybe JsName
_ [] [JsStmt]
stmts Maybe JsExp
ret])) ->
      Maybe JsName -> [JsName] -> [JsStmt] -> Maybe JsExp -> JsExp
JsFun Maybe JsName
nm [JsName]
params
            []
            (JsExp -> Maybe JsExp
forall a. a -> Maybe a
Just
              (JsName -> [JsExp] -> JsExp
JsNew JsName
JsThunk
                     [Maybe JsName -> [JsName] -> [JsStmt] -> Maybe JsExp -> JsExp
JsFun Maybe JsName
forall a. Maybe a
Nothing []
                            ([JsName] -> JsName -> [JsStmt] -> [JsStmt]
optimize [JsName]
params JsName
name ([JsStmt]
stmts [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ [ JsExp -> JsStmt
JsEarlyReturn JsExp
e | Just JsExp
e <- [Maybe JsExp
ret] ]))
                            Maybe JsExp
forall a. Maybe a
Nothing]))
    JsExp
_ -> JsExp
exp
  optimize :: [JsName] -> JsName -> [JsStmt] -> [JsStmt]
optimize [JsName]
params JsName
name [JsStmt]
stmts = [JsStmt]
result where
    result :: [JsStmt]
result = let ([JsStmt]
newstmts,[()]
w) = Writer [()] [JsStmt] -> ([JsStmt], [()])
forall w a. Writer w a -> (a, w)
runWriter Writer [()] [JsStmt]
makeWhile
             in if [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [()]
w
                   then [JsStmt]
stmts
                   else [JsStmt]
newstmts
    makeWhile :: Writer [()] [JsStmt]
makeWhile = do
      [JsStmt]
newstmts <- ([[JsStmt]] -> [JsStmt])
-> WriterT [()] Identity [[JsStmt]] -> Writer [()] [JsStmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[JsStmt]] -> [JsStmt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((JsStmt -> Writer [()] [JsStmt])
-> [JsStmt] -> WriterT [()] Identity [[JsStmt]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JsStmt -> Writer [()] [JsStmt]
forall (f :: * -> *). MonadWriter [()] f => JsStmt -> f [JsStmt]
swap [JsStmt]
stmts)
      [JsStmt] -> Writer [()] [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return [JsExp -> [JsStmt] -> JsStmt
JsWhile (JsLit -> JsExp
JsLit (Bool -> JsLit
JsBool Bool
True)) [JsStmt]
newstmts]
    swap :: JsStmt -> f [JsStmt]
swap JsStmt
stmt = case JsStmt
stmt of
      JsEarlyReturn JsExp
e
        | JsExp -> Bool
tailCall JsExp
e -> do [()] -> f ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [()]
                           [JsStmt] -> f [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return (JsExp -> [JsStmt]
rebind JsExp
e [JsStmt] -> [JsStmt] -> [JsStmt]
forall a. [a] -> [a] -> [a]
++ [JsStmt
JsContinue])
        | Bool
otherwise  -> [JsStmt] -> f [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return [JsStmt
stmt]
      JsIf JsExp
p [JsStmt]
ithen [JsStmt]
ielse -> do
        [JsStmt]
newithen <- ([[JsStmt]] -> [JsStmt]) -> f [[JsStmt]] -> f [JsStmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[JsStmt]] -> [JsStmt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((JsStmt -> f [JsStmt]) -> [JsStmt] -> f [[JsStmt]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JsStmt -> f [JsStmt]
swap [JsStmt]
ithen)
        [JsStmt]
newielse <- ([[JsStmt]] -> [JsStmt]) -> f [[JsStmt]] -> f [JsStmt]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[JsStmt]] -> [JsStmt]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((JsStmt -> f [JsStmt]) -> [JsStmt] -> f [[JsStmt]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JsStmt -> f [JsStmt]
swap [JsStmt]
ielse)
        [JsStmt] -> f [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return [JsExp -> [JsStmt] -> [JsStmt] -> JsStmt
JsIf JsExp
p [JsStmt]
newithen [JsStmt]
newielse]
      JsStmt
e -> [JsStmt] -> f [JsStmt]
forall (m :: * -> *) a. Monad m => a -> m a
return [JsStmt
e]
    tailCall :: JsExp -> Bool
tailCall (JsApp (JsName JsName
cname) [JsExp]
_) = JsName
cname JsName -> JsName -> Bool
forall a. Eq a => a -> a -> Bool
== JsName
name
    tailCall JsExp
_ = Bool
False
    rebind :: JsExp -> [JsStmt]
rebind (JsApp JsExp
_ [JsExp]
args) = (JsExp -> JsName -> JsStmt) -> [JsExp] -> [JsName] -> [JsStmt]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith JsExp -> JsName -> JsStmt
go [JsExp]
args [JsName]
params where
      go :: JsExp -> JsName -> JsStmt
go JsExp
arg JsName
param = JsName -> JsExp -> JsStmt
JsUpdate JsName
param JsExp
arg
    rebind JsExp
e = String -> [JsStmt]
forall a. HasCallStack => String -> a
error (String -> [JsStmt]) -> (JsExp -> String) -> JsExp -> [JsStmt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsExp -> String
forall a. Show a => a -> String
show (JsExp -> [JsStmt]) -> JsExp -> [JsStmt]
forall a b. (a -> b) -> a -> b
$ JsExp
e

-- | Strip redundant forcing from the whole generated code.
stripAndUncurry :: [JsStmt] -> Optimize [JsStmt]
stripAndUncurry :: [JsStmt] -> Optimize [JsStmt]
stripAndUncurry = ([FuncArity] -> JsExp -> Optimize JsExp)
-> [JsStmt] -> Optimize [JsStmt]
applyToExpsInStmts [FuncArity] -> JsExp -> Optimize JsExp
stripFuncForces where
  stripFuncForces :: [FuncArity] -> JsExp -> Optimize JsExp
stripFuncForces [FuncArity]
arities JsExp
exp = case JsExp
exp of
    JsApp (JsName JsName
JsForce) [JsName (JsNameVar QName
f)]
      | Just Int
_ <- QName -> [FuncArity] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup QName
f [FuncArity]
arities -> JsExp -> Optimize JsExp
forall (m :: * -> *) a. Monad m => a -> m a
return (JsName -> JsExp
JsName (QName -> JsName
JsNameVar QName
f))
    JsFun Maybe JsName
nm [JsName]
ps [JsStmt]
stmts Maybe JsExp
body         -> do [JsStmt]
substmts <- (JsStmt -> StateT OptState Identity JsStmt)
-> [JsStmt] -> Optimize [JsStmt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JsStmt -> StateT OptState Identity JsStmt
stripInStmt [JsStmt]
stmts
                                         Maybe JsExp
sbody <- StateT OptState Identity (Maybe JsExp)
-> (JsExp -> StateT OptState Identity (Maybe JsExp))
-> Maybe JsExp
-> StateT OptState Identity (Maybe JsExp)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe JsExp -> StateT OptState Identity (Maybe JsExp)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe JsExp
forall a. Maybe a
Nothing) ((JsExp -> Maybe JsExp)
-> Optimize JsExp -> StateT OptState Identity (Maybe JsExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsExp -> Maybe JsExp
forall a. a -> Maybe a
Just (Optimize JsExp -> StateT OptState Identity (Maybe JsExp))
-> (JsExp -> Optimize JsExp)
-> JsExp
-> StateT OptState Identity (Maybe JsExp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsExp -> Optimize JsExp
go) Maybe JsExp
body
                                         JsExp -> Optimize JsExp
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe JsName -> [JsName] -> [JsStmt] -> Maybe JsExp -> JsExp
JsFun Maybe JsName
nm [JsName]
ps [JsStmt]
substmts Maybe JsExp
sbody)
    JsApp JsExp
a [JsExp]
b                      -> do
      Maybe JsExp
result <- [FuncArity] -> JsExp -> StateT OptState Identity (Maybe JsExp)
walkAndStripForces [FuncArity]
arities JsExp
exp
      case Maybe JsExp
result of
        Just JsExp
strippedExp           -> JsExp -> Optimize JsExp
go JsExp
strippedExp
        Maybe JsExp
Nothing                    -> JsExp -> [JsExp] -> JsExp
JsApp (JsExp -> [JsExp] -> JsExp)
-> Optimize JsExp -> StateT OptState Identity ([JsExp] -> JsExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
go JsExp
a StateT OptState Identity ([JsExp] -> JsExp)
-> StateT OptState Identity [JsExp] -> Optimize JsExp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (JsExp -> Optimize JsExp)
-> [JsExp] -> StateT OptState Identity [JsExp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JsExp -> Optimize JsExp
go [JsExp]
b
    JsNegApp JsExp
e                     -> JsExp -> JsExp
JsNegApp (JsExp -> JsExp) -> Optimize JsExp -> Optimize JsExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
go JsExp
e
    JsTernaryIf JsExp
a JsExp
b JsExp
c              -> JsExp -> JsExp -> JsExp -> JsExp
JsTernaryIf (JsExp -> JsExp -> JsExp -> JsExp)
-> Optimize JsExp
-> StateT OptState Identity (JsExp -> JsExp -> JsExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
go JsExp
a StateT OptState Identity (JsExp -> JsExp -> JsExp)
-> Optimize JsExp -> StateT OptState Identity (JsExp -> JsExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JsExp -> Optimize JsExp
go JsExp
b StateT OptState Identity (JsExp -> JsExp)
-> Optimize JsExp -> Optimize JsExp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JsExp -> Optimize JsExp
go JsExp
c
    JsParen JsExp
e                      -> JsExp -> JsExp
JsParen (JsExp -> JsExp) -> Optimize JsExp -> Optimize JsExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
go JsExp
e
    JsUpdateProp JsExp
e JsName
n JsExp
a             -> JsExp -> JsName -> JsExp -> JsExp
JsUpdateProp (JsExp -> JsName -> JsExp -> JsExp)
-> Optimize JsExp
-> StateT OptState Identity (JsName -> JsExp -> JsExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
go JsExp
e StateT OptState Identity (JsName -> JsExp -> JsExp)
-> StateT OptState Identity JsName
-> StateT OptState Identity (JsExp -> JsExp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JsName -> StateT OptState Identity JsName
forall (f :: * -> *) a. Applicative f => a -> f a
pure JsName
n StateT OptState Identity (JsExp -> JsExp)
-> Optimize JsExp -> Optimize JsExp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JsExp -> Optimize JsExp
go JsExp
a
    JsList [JsExp]
xs                      -> [JsExp] -> JsExp
JsList ([JsExp] -> JsExp)
-> StateT OptState Identity [JsExp] -> Optimize JsExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JsExp -> Optimize JsExp)
-> [JsExp] -> StateT OptState Identity [JsExp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JsExp -> Optimize JsExp
go [JsExp]
xs
    JsEq JsExp
a JsExp
b                       -> JsExp -> JsExp -> JsExp
JsEq (JsExp -> JsExp -> JsExp)
-> Optimize JsExp -> StateT OptState Identity (JsExp -> JsExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
go JsExp
a StateT OptState Identity (JsExp -> JsExp)
-> Optimize JsExp -> Optimize JsExp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JsExp -> Optimize JsExp
go JsExp
b
    JsInfix String
op JsExp
a JsExp
b                 -> String -> JsExp -> JsExp -> JsExp
JsInfix String
op (JsExp -> JsExp -> JsExp)
-> Optimize JsExp -> StateT OptState Identity (JsExp -> JsExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
go JsExp
a StateT OptState Identity (JsExp -> JsExp)
-> Optimize JsExp -> Optimize JsExp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JsExp -> Optimize JsExp
go JsExp
b
    JsObj [(String, JsExp)]
xs                       -> [(String, JsExp)] -> JsExp
JsObj ([(String, JsExp)] -> JsExp)
-> StateT OptState Identity [(String, JsExp)] -> Optimize JsExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, JsExp) -> StateT OptState Identity (String, JsExp))
-> [(String, JsExp)] -> StateT OptState Identity [(String, JsExp)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(String
x,JsExp
y) -> (String
x,) (JsExp -> (String, JsExp))
-> Optimize JsExp -> StateT OptState Identity (String, JsExp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
go JsExp
y) [(String, JsExp)]
xs
    JsNew JsName
name [JsExp]
xs                  -> JsName -> [JsExp] -> JsExp
JsNew JsName
name ([JsExp] -> JsExp)
-> StateT OptState Identity [JsExp] -> Optimize JsExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JsExp -> Optimize JsExp)
-> [JsExp] -> StateT OptState Identity [JsExp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JsExp -> Optimize JsExp
go [JsExp]
xs
    JsExp
e                              -> JsExp -> Optimize JsExp
forall (m :: * -> *) a. Monad m => a -> m a
return JsExp
e

    where
      go :: JsExp -> Optimize JsExp
go = [FuncArity] -> JsExp -> Optimize JsExp
stripFuncForces [FuncArity]
arities
      stripInStmt :: JsStmt -> StateT OptState Identity JsStmt
stripInStmt = [FuncArity]
-> ([FuncArity] -> JsExp -> Optimize JsExp)
-> JsStmt
-> StateT OptState Identity JsStmt
applyToExpsInStmt [FuncArity]
arities [FuncArity] -> JsExp -> Optimize JsExp
stripFuncForces

-- | Strip redundant forcing from an application if possible.
walkAndStripForces :: [FuncArity] -> JsExp -> Optimize (Maybe JsExp)
walkAndStripForces :: [FuncArity] -> JsExp -> StateT OptState Identity (Maybe JsExp)
walkAndStripForces [FuncArity]
arities = Bool -> [JsExp] -> JsExp -> StateT OptState Identity (Maybe JsExp)
forall (m :: * -> *).
MonadState OptState m =>
Bool -> [JsExp] -> JsExp -> m (Maybe JsExp)
go Bool
True [] where
  go :: Bool -> [JsExp] -> JsExp -> m (Maybe JsExp)
go Bool
frst [JsExp]
args JsExp
app = case JsExp
app of
    JsApp (JsName JsName
JsForce) [JsExp
e] ->
      if Bool
frst
        then do
          Maybe JsExp
result <- Bool -> [JsExp] -> JsExp -> m (Maybe JsExp)
go Bool
False [JsExp]
args JsExp
e
          case Maybe JsExp
result of
            Maybe JsExp
Nothing -> Maybe JsExp -> m (Maybe JsExp)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe JsExp
forall a. Maybe a
Nothing
            Just JsExp
ex -> Maybe JsExp -> m (Maybe JsExp)
forall (m :: * -> *) a. Monad m => a -> m a
return (JsExp -> Maybe JsExp
forall a. a -> Maybe a
Just (JsExp -> [JsExp] -> JsExp
JsApp (JsName -> JsExp
JsName JsName
JsForce) [JsExp
ex]))
        else Bool -> [JsExp] -> JsExp -> m (Maybe JsExp)
go Bool
False [JsExp]
args JsExp
e
    JsApp JsExp
op [JsExp
arg] -> Bool -> [JsExp] -> JsExp -> m (Maybe JsExp)
go Bool
False (JsExp
argJsExp -> [JsExp] -> [JsExp]
forall a. a -> [a] -> [a]
:[JsExp]
args) JsExp
op
    JsName (JsNameVar QName
f)
      | Just Int
arity <- QName -> [FuncArity] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup QName
f [FuncArity]
arities, [JsExp] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [JsExp]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arity -> do
        (OptState -> OptState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((OptState -> OptState) -> m ()) -> (OptState -> OptState) -> m ()
forall a b. (a -> b) -> a -> b
$ \OptState
s -> OptState
s { optUncurry :: [QName]
optUncurry = QName
f QName -> [QName] -> [QName]
forall a. a -> [a] -> [a]
: OptState -> [QName]
optUncurry OptState
s }
        Maybe JsExp -> m (Maybe JsExp)
forall (m :: * -> *) a. Monad m => a -> m a
return (JsExp -> Maybe JsExp
forall a. a -> Maybe a
Just (JsExp -> [JsExp] -> JsExp
JsApp (JsName -> JsExp
JsName (QName -> JsName
JsNameVar (QName -> QName
renameUncurried QName
f))) [JsExp]
args))
    JsExp
_ -> Maybe JsExp -> m (Maybe JsExp)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe JsExp
forall a. Maybe a
Nothing

-- | Apply the given function to the top-level expressions in the
-- given statements.
applyToExpsInStmts :: ([FuncArity] -> JsExp -> Optimize JsExp) -> [JsStmt] -> Optimize [JsStmt]
applyToExpsInStmts :: ([FuncArity] -> JsExp -> Optimize JsExp)
-> [JsStmt] -> Optimize [JsStmt]
applyToExpsInStmts [FuncArity] -> JsExp -> Optimize JsExp
f [JsStmt]
stmts = (JsStmt -> StateT OptState Identity JsStmt)
-> [JsStmt] -> Optimize [JsStmt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([FuncArity]
-> ([FuncArity] -> JsExp -> Optimize JsExp)
-> JsStmt
-> StateT OptState Identity JsStmt
applyToExpsInStmt ([JsStmt] -> [FuncArity]
collectFuncs [JsStmt]
stmts) [FuncArity] -> JsExp -> Optimize JsExp
f) [JsStmt]
stmts

-- | Apply the given function to the top-level expressions in the
-- given statement.
applyToExpsInStmt :: [FuncArity] -> ([FuncArity] -> JsExp -> Optimize JsExp) -> JsStmt -> Optimize JsStmt
applyToExpsInStmt :: [FuncArity]
-> ([FuncArity] -> JsExp -> Optimize JsExp)
-> JsStmt
-> StateT OptState Identity JsStmt
applyToExpsInStmt [FuncArity]
funcs [FuncArity] -> JsExp -> Optimize JsExp
f = JsStmt -> StateT OptState Identity JsStmt
uncurryInStmt where
  transform :: JsExp -> Optimize JsExp
transform = [FuncArity] -> JsExp -> Optimize JsExp
f [FuncArity]
funcs
  uncurryInStmt :: JsStmt -> StateT OptState Identity JsStmt
uncurryInStmt JsStmt
stmt = case JsStmt
stmt of
    JsVar JsName
name JsExp
exp              -> JsName -> JsExp -> JsStmt
JsVar JsName
name (JsExp -> JsStmt)
-> Optimize JsExp -> StateT OptState Identity JsStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
transform JsExp
exp
    JsSetQName Maybe SrcSpan
l QName
name JsExp
exp       -> Maybe SrcSpan -> QName -> JsExp -> JsStmt
JsSetQName Maybe SrcSpan
l QName
name (JsExp -> JsStmt)
-> Optimize JsExp -> StateT OptState Identity JsStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
transform JsExp
exp
    JsEarlyReturn JsExp
exp           -> JsExp -> JsStmt
JsEarlyReturn (JsExp -> JsStmt)
-> Optimize JsExp -> StateT OptState Identity JsStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
transform JsExp
exp
    JsIf JsExp
op [JsStmt]
ithen [JsStmt]
ielse         -> JsExp -> [JsStmt] -> [JsStmt] -> JsStmt
JsIf (JsExp -> [JsStmt] -> [JsStmt] -> JsStmt)
-> Optimize JsExp
-> StateT OptState Identity ([JsStmt] -> [JsStmt] -> JsStmt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Optimize JsExp
transform JsExp
op
                                        StateT OptState Identity ([JsStmt] -> [JsStmt] -> JsStmt)
-> Optimize [JsStmt]
-> StateT OptState Identity ([JsStmt] -> JsStmt)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (JsStmt -> StateT OptState Identity JsStmt)
-> [JsStmt] -> Optimize [JsStmt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JsStmt -> StateT OptState Identity JsStmt
uncurryInStmt [JsStmt]
ithen
                                        StateT OptState Identity ([JsStmt] -> JsStmt)
-> Optimize [JsStmt] -> StateT OptState Identity JsStmt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (JsStmt -> StateT OptState Identity JsStmt)
-> [JsStmt] -> Optimize [JsStmt]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JsStmt -> StateT OptState Identity JsStmt
uncurryInStmt [JsStmt]
ielse
    JsStmt
s -> JsStmt -> StateT OptState Identity JsStmt
forall (f :: * -> *) a. Applicative f => a -> f a
pure JsStmt
s

-- | Collect functions and their arity from the whole codeset.
collectFuncs :: [JsStmt] -> [FuncArity]
collectFuncs :: [JsStmt] -> [FuncArity]
collectFuncs = ([FuncArity] -> [FuncArity] -> [FuncArity]
forall a. [a] -> [a] -> [a]
++ [FuncArity]
prim) ([FuncArity] -> [FuncArity])
-> ([JsStmt] -> [FuncArity]) -> [JsStmt] -> [FuncArity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JsStmt -> [FuncArity]) -> [JsStmt] -> [FuncArity]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap JsStmt -> [FuncArity]
collectFunc where
  collectFunc :: JsStmt -> [FuncArity]
collectFunc (JsSetQName Maybe SrcSpan
_ QName
name JsExp
exp) | Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = [(QName
name,Int
arity)]
    where arity :: Int
arity = JsExp -> Int
expArity JsExp
exp
  collectFunc JsStmt
_ = []
  prim :: [FuncArity]
prim = ((Name (), Int) -> FuncArity) -> [(Name (), Int)] -> [FuncArity]
forall a b. (a -> b) -> [a] -> [b]
map ((Name () -> QName) -> (Name (), Int) -> FuncArity
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (() -> ModuleName () -> Name () -> QName
forall l. l -> ModuleName l -> Name l -> QName l
Qual () (() -> String -> ModuleName ()
forall l. l -> String -> ModuleName l
ModuleName () String
"Fay$"))) ([(Name (), Int)]
unary [(Name (), Int)] -> [(Name (), Int)] -> [(Name (), Int)]
forall a. [a] -> [a] -> [a]
++ [(Name (), Int)]
binary)
  unary :: [(Name (), Int)]
unary = (Name () -> (Name (), Int)) -> [Name ()] -> [(Name (), Int)]
forall a b. (a -> b) -> [a] -> [b]
map (,Int
1) [() -> String -> Name ()
forall l. l -> String -> Name l
Ident () String
"return"]
  binary :: [(Name (), Int)]
binary = (String -> (Name (), Int)) -> [String] -> [(Name (), Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((,Int
2) (Name () -> (Name (), Int))
-> (String -> Name ()) -> String -> (Name (), Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> String -> Name ()
forall l. l -> String -> Name l
Ident ())
               [String
"then",String
"bind",String
"mult",String
"mult",String
"add",String
"sub",String
"div"
               ,String
"eq",String
"neq",String
"gt",String
"lt",String
"gte",String
"lte",String
"and",String
"or"]

-- | Get the arity of an expression.
expArity :: JsExp -> Int
expArity :: JsExp -> Int
expArity (JsFun Maybe JsName
_ [JsName]
_ [JsStmt]
_ Maybe JsExp
mexp) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> (JsExp -> Int) -> Maybe JsExp -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 JsExp -> Int
expArity Maybe JsExp
mexp
expArity JsExp
_ = Int
0

-- | Change foo(x)(y) to foo$uncurried(x,y).
uncurryBinding :: [JsStmt] -> N.QName -> Maybe JsStmt
uncurryBinding :: [JsStmt] -> QName -> Maybe JsStmt
uncurryBinding [JsStmt]
stmts QName
qname = [JsStmt] -> Maybe JsStmt
forall a. [a] -> Maybe a
listToMaybe ((JsStmt -> Maybe JsStmt) -> [JsStmt] -> [JsStmt]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe JsStmt -> Maybe JsStmt
funBinding [JsStmt]
stmts)
  where
    funBinding :: JsStmt -> Maybe JsStmt
funBinding JsStmt
stmt = case JsStmt
stmt of
      JsVar (JsNameVar QName
name) JsExp
body
        | QName
name QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
qname -> JsName -> JsExp -> JsStmt
JsVar (QName -> JsName
JsNameVar (QName -> QName
renameUncurried QName
name)) (JsExp -> JsStmt) -> Maybe JsExp -> Maybe JsStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Maybe JsExp
uncurryIt JsExp
body
      JsSetQName Maybe SrcSpan
l QName
name JsExp
body
        | QName
name QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
qname -> Maybe SrcSpan -> QName -> JsExp -> JsStmt
JsSetQName Maybe SrcSpan
l (QName -> QName
renameUncurried QName
name) (JsExp -> JsStmt) -> Maybe JsExp -> Maybe JsStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JsExp -> Maybe JsExp
uncurryIt JsExp
body
      JsStmt
_ -> Maybe JsStmt
forall a. Maybe a
Nothing

    uncurryIt :: JsExp -> Maybe JsExp
uncurryIt = JsExp -> Maybe JsExp
forall a. a -> Maybe a
Just (JsExp -> Maybe JsExp) -> (JsExp -> JsExp) -> JsExp -> Maybe JsExp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [JsName] -> JsExp -> JsExp
go [] where
      go :: [JsName] -> JsExp -> JsExp
go [JsName]
args JsExp
exp = case JsExp
exp of
        JsFun Maybe JsName
_ [JsName
arg] [] (Just JsExp
body) -> [JsName] -> JsExp -> JsExp
go (JsName
arg JsName -> [JsName] -> [JsName]
forall a. a -> [a] -> [a]
: [JsName]
args) JsExp
body
        JsExp
inner -> Maybe JsName -> [JsName] -> [JsStmt] -> Maybe JsExp -> JsExp
JsFun Maybe JsName
forall a. Maybe a
Nothing ([JsName] -> [JsName]
forall a. [a] -> [a]
reverse [JsName]
args) [] (JsExp -> Maybe JsExp
forall a. a -> Maybe a
Just JsExp
inner)

-- | Rename an uncurried copy of a curried function.
renameUncurried :: N.QName -> N.QName
renameUncurried :: QName -> QName
renameUncurried QName
q = case QName
q of
  Qual ()
_ ModuleName ()
m Name ()
n -> () -> ModuleName () -> Name () -> QName
forall l. l -> ModuleName l -> Name l -> QName l
Qual () ModuleName ()
m (Name () -> Name ()
forall l. Name l -> Name ()
renameUnQual Name ()
n)
  UnQual ()
_ Name ()
n -> () -> Name () -> QName
forall l. l -> Name l -> QName l
UnQual () (Name () -> Name ()
forall l. Name l -> Name ()
renameUnQual Name ()
n)
  QName
s -> QName
s
  where
    renameUnQual :: Name l -> Name ()
renameUnQual Name l
n = case Name l
n of
      Ident l
_ String
nom -> () -> String -> Name ()
forall l. l -> String -> Name l
Ident () (String
nom String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
postfix)
      Symbol l
_ String
nom -> () -> String -> Name ()
forall l. l -> String -> Name l
Symbol () (String
nom String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
postfix)
    postfix :: String
postfix = String
"$uncurried"