Jikka 5.5.0.0 → 5.6.0.0

raw patch · 51 files changed

+1137/−623 lines, 51 filesdep −hlintdep −ormoluPVP ok

version bump matches the API change (PVP)

Dependencies removed: hlint, ormolu

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−2
• Jikka.cabal +6/−3
• README.md +7/−11
• src/Jikka/CPlusPlus/Convert/AddMain.hs +8/−7
• src/Jikka/CPlusPlus/Convert/BurnFlavouredNames.hs +79/−0
• src/Jikka/CPlusPlus/Convert/EmbedOriginalCode.hs +18/−0
• src/Jikka/CPlusPlus/Convert/FromCore.hs +197/−145
• src/Jikka/CPlusPlus/Convert/InlineSetAt.hs +4/−3
• src/Jikka/CPlusPlus/Convert/MoveSemantics.hs +9/−9
• src/Jikka/CPlusPlus/Convert/OptimizeRange.hs +11/−6
• src/Jikka/CPlusPlus/Convert/UnpackTuples.hs +24/−21
• src/Jikka/CPlusPlus/Convert/UseInitialization.hs +4/−4
• src/Jikka/CPlusPlus/Format.hs +52/−41
• src/Jikka/CPlusPlus/Language/Expr.hs +22/−10
• src/Jikka/CPlusPlus/Language/Util.hs +88/−44
• src/Jikka/CPlusPlus/Language/VariableAnalysis.hs +2/−2
• src/Jikka/Common/Name.hs +39/−0
• src/Jikka/Core/Convert/Alpha.hs +3/−4
• src/Jikka/Core/Convert/Eta.hs +12/−25
• src/Jikka/Core/Convert/SegmentTree.hs +4/−4
• src/Jikka/Core/Convert/TypeInfer.hs +2/−2
• src/Jikka/Core/Evaluate.hs +3/−3
• src/Jikka/Core/Format.hs +7/−7
• src/Jikka/Core/Language/Beta.hs +2/−2
• src/Jikka/Core/Language/Eta.hs +95/−0
• src/Jikka/Core/Language/Expr.hs +15/−8
• src/Jikka/Core/Language/FreeVars.hs +16/−2
• src/Jikka/Core/Language/NameCheck.hs +2/−2
• src/Jikka/Core/Language/QuasiRules.hs +11/−12
• src/Jikka/Core/Language/TypeCheck.hs +5/−5
• src/Jikka/Core/Language/Util.hs +3/−8
• src/Jikka/Core/Parse/Happy.y +7/−6
• src/Jikka/Main.hs +2/−4
• src/Jikka/Main/Subcommand/Convert.hs +4/−1
• src/Jikka/Python/Convert/ToRestrictedPython.hs +3/−1
• src/Jikka/RestrictedPython/Convert/Alpha.hs +7/−7
• src/Jikka/RestrictedPython/Convert/DefaultMain.hs +6/−6
• src/Jikka/RestrictedPython/Convert/ParseMain.hs +15/−15
• src/Jikka/RestrictedPython/Convert/ToCore.hs +15/−15
• src/Jikka/RestrictedPython/Evaluate.hs +4/−4
• src/Jikka/RestrictedPython/Format.hs +6/−6
• src/Jikka/RestrictedPython/Language/Builtin.hs +2/−2
• src/Jikka/RestrictedPython/Language/Expr.hs +18/−9
• src/Jikka/RestrictedPython/Language/Util.hs +19/−8
• test/Jikka/CPlusPlus/Convert/FromCoreSpec.hs +18/−14
• test/Jikka/CPlusPlus/Convert/MoveSemanticsSpec.hs +9/−8
• test/Jikka/CPlusPlus/Convert/UnpackTuplesSpec.hs +16/−12
• test/Jikka/CPlusPlus/FormatSpec.hs +19/−16
• test/Jikka/Core/Convert/EtaSpec.hs +26/−16
• test/Jikka/Core/Convert/TypeInferSpec.hs +69/−81
• test/Jikka/Core/Language/EtaSpec.hs +110/−0

@@ -1,15 +1,25 @@ # Changelog for Jikka +## 2021-09-25: v5.6.0.0++Feature:++- Use readable names for variables in generated C++ code ([#232](https://github.com/kmyk/Jikka/pull/232), [#238](https://github.com/kmyk/Jikka/pull/238) by [@kmyk](https://github.com/kmyk))++Bug Fix:++- Fix type errors of `map`, `zip`, and `enumerate` ([#237](https://github.com/kmyk/Jikka/pull/237) by [@zer0-star](https://github.com/zer0-star))+ ## 2021-09-04: v5.5.0.0  Features:  - Now Jikka is available on Web: <https://kmyk.github.io/Jikka/playground/>-- Solve some formulae in the form of `∑ᵢ ∑ⱼ |aᵢ−aⱼ|` [#210](https://github.com/kmyk/Jikka/pull/210) by [@kmyk](https://github.com/kmyk)+- Solve some formulae in the form of `∑ᵢ ∑ⱼ |aᵢ−aⱼ|` ([#210](https://github.com/kmyk/Jikka/pull/210) by [@kmyk](https://github.com/kmyk))  Bug Fix: -- Fix a bug about `std::accumulate` ([#205](https://github.com/kmyk/Jikka/pull/205) by [@riantkb](https://github.com/riantkb)+- Fix a bug about `std::accumulate` ([#205](https://github.com/kmyk/Jikka/pull/205) by [@riantkb](https://github.com/riantkb))  ## 2021-08-24: v5.4.0.0 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           Jikka-version:        5.5.0.0+version:        5.6.0.0 synopsis:       A transpiler from Python to C++ for competitive programming description:    Please see the README on GitHub at <https://github.com/kmyk/Jikka> category:       Compilers/Interpreters@@ -58,6 +58,7 @@       Jikka.Common.Location       Jikka.Common.Matrix       Jikka.Common.ModInt+      Jikka.Common.Name       Jikka.Common.Parse.JoinLines       Jikka.Common.Parse.OffsideRule       Jikka.Common.Parse.Read@@ -95,6 +96,7 @@       Jikka.Core.Language.AssertedHint       Jikka.Core.Language.Beta       Jikka.Core.Language.BuiltinPatterns+      Jikka.Core.Language.Eta       Jikka.Core.Language.Expr       Jikka.Core.Language.FreeVars       Jikka.Core.Language.LambdaPatterns@@ -114,6 +116,8 @@       Jikka.CPlusPlus.Convert       Jikka.CPlusPlus.Convert.AddMain       Jikka.CPlusPlus.Convert.BundleRuntime+      Jikka.CPlusPlus.Convert.BurnFlavouredNames+      Jikka.CPlusPlus.Convert.EmbedOriginalCode       Jikka.CPlusPlus.Convert.FromCore       Jikka.CPlusPlus.Convert.InlineSetAt       Jikka.CPlusPlus.Convert.MoveSemantics@@ -262,6 +266,7 @@       Jikka.Core.Language.ArithmeticExprSpec       Jikka.Core.Language.AssertedHintSpec       Jikka.Core.Language.BetaSpec+      Jikka.Core.Language.EtaSpec       Jikka.Core.ParseSpec       Jikka.CPlusPlus.Convert.FromCoreSpec       Jikka.CPlusPlus.Convert.MoveSemanticsSpec@@ -299,10 +304,8 @@     , containers >=0.6.0 && <0.7     , deepseq >=1.4.4 && <1.5     , directory >=1.3.3 && <1.4-    , hlint     , hspec     , mtl >=2.2.2 && <2.3-    , ormolu     , template-haskell >=2.15.0 && <2.17     , text >=1.2.3 && <1.3     , transformers >=0.5.6 && <0.6

@@ -56,10 +56,8 @@ For users:  - [docs/language.md](https://github.com/kmyk/Jikka/blob/master/docs/language.md)-  - [docs/language.ja.md](https://github.com/kmyk/Jikka/blob/master/docs/language.ja.md) (Japanese translation)   - The language specification of our restricted Python / Jikka で使われる制限された Python の言語仕様 - [docs/optimization.md](https://github.com/kmyk/Jikka/blob/master/docs/optimization.md)-  - [docs/optimization.ja.md](https://github.com/kmyk/Jikka/blob/master/docs/optimization.ja.md) (Japanese translation)   - A list of optimizations which Jikka does / Jikka が行なってくれる最適化の一覧 - [examples/](https://github.com/kmyk/Jikka/blob/master/examples)   - [gallery](https://kmyk.github.io/Jikka/gallery)@@ -69,18 +67,16 @@ For developpers:  - [CONTRIBUTING.md](https://github.com/kmyk/Jikka/blob/master/CONTRIBUTING.md)-  - [CONTRIBUTING.ja.md](https://github.com/kmyk/Jikka/blob/master/CONTRIBUTING.ja.md) (Japanese translation) - My blog article [競技プログラミングの問題を自動で解きたい - うさぎ小屋](https://kimiyuki.net/blog/2020/12/09/automated-solvers-of-competitive-programming/) (Japanese)-  - 競技プログラミングの問題を自動で解くとはどういうことなのかについて+  - On what it means to automatically solve problems of competitive programming / 競技プログラミングの問題を自動で解くとはどういうことなのかについて - [docs/how-it-works.pdf](https://github.com/kmyk/Jikka/blob/master/docs/how-it-works.pdf) (Japanese)-  - 動作原理や関連する理論について-- [docs/DESIGN.md](https://github.com/kmyk/Jikka/blob/master/docs/DESIGN.md) (Japanese)-  - 実装方針について-- [docs/internal.ja.md](https://github.com/kmyk/Jikka/blob/master/docs/internal.ja.md) (Japanese)-  - 具体的な処理の流れについて+  - How it works and related theories / 動作原理や関連する理論+- [docs/DESIGN.md](https://github.com/kmyk/Jikka/blob/master/docs/DESIGN.md)+  - The policy of designs / 実装方針+- [docs/internal.md](https://github.com/kmyk/Jikka/blob/master/docs/internal.md)+  - The overview of internal processes / 内部の処理の流れ - [docs/core.md](https://github.com/kmyk/Jikka/blob/master/docs/core.md)-  - [docs/core.ja.md](https://github.com/kmyk/Jikka/blob/master/docs/core.ja.md) (Japanese)-  - core 言語の説明+  - The specification of core language / core 言語の仕様 - [Haddock](https://hackage.haskell.org/package/Jikka)   - [Haddock (master)](https://kmyk.github.io/Jikka/haddock) 

@@ -23,6 +23,7 @@ import Jikka.Common.Alpha import Jikka.Common.Error import qualified Jikka.Common.IOFormat as F+import Jikka.Common.Name  lookup' :: (MonadState (M.Map String VarName) m, MonadError Error m) => String -> m VarName lookup' x = do@@ -38,7 +39,7 @@   F.At e i -> at <$> runFormatExpr e <*> (Var <$> lookup' i)   F.Len e -> do     e <- runFormatExpr e-    return $ cast TyInt32 (Call MethodSize [e])+    return $ cast TyInt32 (Call' MethodSize [e])  runMainDeclare :: (MonadState (M.Map String VarName) m, MonadAlpha m, MonadError Error m) => F.IOFormat -> m [(S.Set VarName, Statement)] runMainDeclare format = go M.empty (F.inputTree format)@@ -46,7 +47,7 @@     go sizes = \case       F.Exp e -> do         (x, indices) <- F.unpackSubscriptedVar e-        y <- renameVarName LocalNameKind x+        y <- renameVarName' LocalNameHint x         modify' $ M.insert x y         let lookupSize i = case M.lookup i sizes of               Just e -> return e@@ -78,7 +79,7 @@           (stmts', initialized) <- go initialized (F.Seq formats)           return (stmts ++ stmts', initialized)         F.Loop i n body -> do-          j <- renameVarName LoopCounterNameKind i+          j <- renameVarName' LoopCounterNameHint i           modify' $ M.insert i j           n <- runFormatExpr n           (body, initialized) <- go initialized body@@ -90,14 +91,14 @@ runMainSolve :: (MonadState (M.Map String VarName) m, MonadAlpha m, MonadError Error m) => F.IOFormat -> m Statement runMainSolve format = do   args <- mapM lookup' (F.inputVariables format)-  let solve = Call (Function "solve" []) (map Var args)+  let solve = Call' (Function "solve" []) (map Var args)   case F.outputVariables format of     Left x -> do-      y <- renameVarName LocalNameKind x+      y <- renameVarName' LocalNameHint x       modify' $ M.insert x y       return $ Declare TyAuto y (DeclareCopy solve)     Right xs -> do-      ys <- mapM (renameVarName LocalNameKind) xs+      ys <- mapM (renameVarName' LocalNameHint) xs       modify' $ \env -> foldl (\env (x, y) -> M.insert x y env) env (zip xs ys)       return $ DeclareDestructure ys solve @@ -111,7 +112,7 @@       F.Newline -> return [coutStatement (Lit (LitChar '\n'))]       F.Seq formats -> concat <$> mapM go formats       F.Loop i n body -> do-        j <- renameVarName LoopCounterNameKind i+        j <- renameVarName' LoopCounterNameHint i         modify' $ M.insert i j         n <- runFormatExpr n         body <- go body

@@ -0,0 +1,79 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}++-- |+-- Module      : Jikka.CPlusPlus.Convert.BurnFlavouredNames+-- Description : remove unique numbers from names as a preprocess to emit the result source code. / 結果のソースコードを出力する前処理として、名前に付けられた一意な整数を解決します。+-- Copyright   : (c) Kimiyuki Onaka, 2020+-- License     : Apache License 2.0+-- Maintainer  : kimiyuki95@gmail.com+-- Stability   : experimental+-- Portability : portable+module Jikka.CPlusPlus.Convert.BurnFlavouredNames+  ( run,+  )+where++import Control.Monad.State.Strict+import qualified Data.Map as M+import Data.Maybe+import qualified Data.Set as S+import Jikka.CPlusPlus.Language.Expr+import Jikka.CPlusPlus.Language.Util+import Jikka.Common.Alpha+import Jikka.Common.Error+import Jikka.Common.Name++data Env = Env+  { renameMapping :: M.Map VarName VarName,+    usedVars :: S.Set String+  }+  deriving (Eq, Ord, Read, Show)++emptyEnv :: Env+emptyEnv =+  Env+    { renameMapping = M.empty,+      usedVars = S.empty+    }++fromNameHint :: Maybe NameHint -> String+fromNameHint = \case+  Nothing -> "u"+  Just LocalNameHint -> "x"+  Just LocalArgumentNameHint -> "b"+  Just LoopCounterNameHint -> "i"+  Just ConstantNameHint -> "c"+  Just FunctionNameHint -> "f"+  Just ArgumentNameHint -> "a"+  Just (AdHocNameHint hint) -> hint++chooseOccName :: S.Set String -> VarName -> String+chooseOccName used (VarName occ _ kind) =+  let occ_workaround = (\s -> if '$' `elem` s then Nothing else Just s) =<< occ -- TODO: Remove this after Python stops using variables with `$`.+      base = fromMaybe (fromNameHint kind) occ_workaround+      occs = base : map (\i -> base ++ show i) [2 ..]+      occ' = head $ filter (`S.notMember` used) occs+   in occ'++rename :: MonadState Env m => VarName -> m VarName+rename x = do+  y <- gets $ M.lookup x . renameMapping+  case y of+    Just y -> return y+    Nothing -> do+      y' <- flip chooseOccName x <$> gets usedVars+      let y = VarName (Just y') Nothing Nothing+      modify $ \env ->+        env+          { renameMapping = M.insert x y (renameMapping env),+            usedVars = S.insert y' (usedVars env)+          }+      return y++runProgram :: MonadState Env m => Program -> m Program+runProgram = mapVarNameProgramM rename++run :: (MonadAlpha m, MonadError Error m) => Program -> m Program+run prog = wrapError' "Jikka.CPlusPlus.Convert.BurnFlavouredNames" $ do+  evalStateT (runProgram prog) emptyEnv

@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++module Jikka.CPlusPlus.Convert.EmbedOriginalCode where++import qualified Data.Text as T+import Data.Version (showVersion)+import Paths_Jikka (version)++run' :: T.Text -> T.Text+run' input =+  let headers =+        [ "// This C++ code is transpiled using Jikka transpiler v" <> T.pack (showVersion version) <> " https://github.com/kmyk/Jikka",+          "// The original Python code:"+        ]+   in T.unlines (headers ++ map ("//     " <>) (T.lines input))++run :: T.Text -> T.Text -> T.Text+run input output = run' input <> output

@@ -23,8 +23,10 @@ import qualified Jikka.CPlusPlus.Language.Util as Y import Jikka.Common.Alpha import Jikka.Common.Error+import Jikka.Common.Name import qualified Jikka.Core.Format as X (formatBuiltinIsolated, formatType) import qualified Jikka.Core.Language.BuiltinPatterns as X+import qualified Jikka.Core.Language.Eta as X import qualified Jikka.Core.Language.Expr as X import qualified Jikka.Core.Language.LambdaPatterns as X import qualified Jikka.Core.Language.TypeCheck as X@@ -33,19 +35,68 @@ -------------------------------------------------------------------------------- -- monad -renameVarName' :: MonadAlpha m => Y.NameKind -> X.VarName -> m Y.VarName-renameVarName' kind x = Y.renameVarName kind (X.unVarName x)+renameVarName' :: MonadAlpha m => NameHint -> X.VarName -> m Y.VarName+renameVarName' kind (X.VarName occ _) = case occ of+  Nothing -> Y.newFreshName kind+  Just occ -> Y.renameVarName' kind occ -type Env = [(X.VarName, X.Type, Y.VarName)]+renameFunName' :: MonadError Error m => X.VarName -> m Y.FunName+renameFunName' = \case+  X.VarName (Just occ) _ -> return $ Y.FunName occ+  _ -> throwInternalError "annonymous toplevel-let is not allowed" +newFreshNameWithAdHocHintFromExpr :: MonadAlpha m => String -> Y.Expr -> m Y.VarName+newFreshNameWithAdHocHintFromExpr prefix e = case e of+  Y.Var (Y.VarName (Just occ) _ _) -> Y.newFreshName (AdHocNameHint (prefix ++ "_" ++ occ))+  _ -> Y.newFreshName (AdHocNameHint prefix)++newFreshNameWithAdHocHintFromExpr' :: MonadAlpha m => String -> X.Expr -> m Y.VarName+newFreshNameWithAdHocHintFromExpr' prefix e = case e of+  X.Var (X.VarName (Just occ) _) -> Y.newFreshName (AdHocNameHint (prefix ++ "_" ++ occ))+  _ -> Y.newFreshName (AdHocNameHint prefix)++data Env = Env+  { typeEnv :: [(X.VarName, X.Type)],+    varMapping :: [(X.VarName, Y.VarName)],+    funMapping :: [(X.VarName, Y.FunName)]+  }+  deriving (Eq, Ord, Show, Read)++emptyEnv :: Env+emptyEnv =+  Env+    { typeEnv = [],+      varMapping = [],+      funMapping = []+    }++pushVar :: X.VarName -> X.Type -> Y.VarName -> Env -> Env+pushVar x t y env =+  env+    { typeEnv = (x, t) : typeEnv env,+      varMapping = (x, y) : varMapping env+    }++pushFun :: X.VarName -> X.Type -> Y.FunName -> Env -> Env+pushFun x t y env =+  env+    { typeEnv = (x, t) : typeEnv env,+      funMapping = (x, y) : funMapping env+    }+ typecheckExpr :: MonadError Error m => Env -> X.Expr -> m X.Type-typecheckExpr env = X.typecheckExpr (map (\(x, t, _) -> (x, t)) env)+typecheckExpr env = X.typecheckExpr (typeEnv env)  lookupVarName :: MonadError Error m => Env -> X.VarName -> m Y.VarName-lookupVarName env x = case lookup x (map (\(x, _, y) -> (x, y)) env) of+lookupVarName env x = case lookup x (varMapping env) of   Just y -> return y-  Nothing -> throwInternalError $ "undefined variable: " ++ X.unVarName x+  Nothing -> throwInternalError $ "undefined variable: " ++ X.formatVarName x +lookupFunName :: MonadError Error m => Env -> X.VarName -> m Y.FunName+lookupFunName env x = case lookup x (funMapping env) of+  Just y -> return y+  Nothing -> throwInternalError $ "undefined function: " ++ X.formatVarName x+ class Monad m => MonadStatements m where   useStatement :: Y.Statement -> m () @@ -104,7 +155,7 @@     return $ Y.vecCtor t []   X.LitBottom t err -> do     t <- runType t-    return $ Y.Call (Y.Function "jikka::error" [t]) [Y.Lit (Y.LitString err)]+    return $ Y.Call' (Y.Function "jikka::error" [t]) [Y.Lit (Y.LitString err)]  arityOfBuiltin :: MonadError Error m => X.Builtin -> [X.Type] -> m Int arityOfBuiltin builtin ts = case builtin of@@ -123,8 +174,8 @@   t <- runType t   n <- runExpr env n   x <- runExpr env x-  y <- Y.newFreshName Y.LocalNameKind-  i <- Y.newFreshName Y.LoopCounterNameKind+  y <- Y.newFreshName LocalNameHint+  i <- Y.newFreshName LoopCounterNameHint   (stmtsF, body, f) <- runExprFunction env f (Y.Var y)   useStatement $ Y.Declare t y (Y.DeclareCopy x)   useStatements stmtsF@@ -142,7 +193,7 @@         return $ Y.Cond e1' e2' e3'     _ -> do       t <- runType t-      phi <- Y.newFreshName Y.LocalNameKind+      phi <- Y.newFreshName LocalNameHint       let assign = Y.Assign . Y.AssignExpr Y.SimpleAssign (Y.LeftVar phi)       useStatement $ Y.Declare t phi Y.DeclareDefault       useStatement $ Y.If e1' (stmts2 ++ [assign e2']) (Just (stmts3 ++ [assign e3']))@@ -154,8 +205,8 @@   xs <- runExpr env xs   t1 <- runType t1   t2 <- runType t2-  y <- Y.newFreshName Y.LocalNameKind-  x <- Y.newFreshName Y.LocalNameKind+  y <- Y.newFreshName LocalNameHint+  x <- Y.newFreshName LocalNameHint   (stmtsF, body, f) <- runExprFunction2 env f (Y.Var y) (Y.Var x)   useStatement $ Y.Declare t2 y (Y.DeclareCopy init)   useStatements stmtsF@@ -164,7 +215,7 @@  runMap :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Type -> X.Type -> X.Expr -> X.Expr -> m Y.Expr runMap env _ t2 f xs = do-  ys <- Y.newFreshName Y.LocalNameKind+  ys <- newFreshNameWithAdHocHintFromExpr' "mapped" xs   t2 <- runType t2   case (f, xs) of     -- optimize @map (const e) xs@@@ -176,7 +227,7 @@     -- other cases     _ -> do       xs <- runExpr env xs-      i <- Y.newFreshName Y.LoopCounterNameKind+      i <- Y.newFreshName LoopCounterNameHint       (stmtsF, body, f) <- runExprFunction env f (Y.at xs (Y.Var i))       useStatement $ Y.Declare (Y.TyVector t2) ys (Y.DeclareCopy (Y.vecCtor t2 [Y.size xs]))       useStatements stmtsF@@ -264,18 +315,18 @@     X.Plus -> go02 $ \e1 e2 -> Y.BinOp Y.Add e1 e2     X.Minus -> go02 $ \e1 e2 -> Y.BinOp Y.Sub e1 e2     X.Mult -> go02 $ \e1 e2 -> Y.BinOp Y.Mul e1 e2-    X.FloorDiv -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::floordiv" []) [e1, e2]-    X.FloorMod -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::floormod" []) [e1, e2]-    X.CeilDiv -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::ceildiv" []) [e1, e2]-    X.CeilMod -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::ceilmod" []) [e1, e2]-    X.JustDiv -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::justdiv" []) [e1, e2]-    X.Pow -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::notmod::pow" []) [e1, e2]+    X.FloorDiv -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::floordiv" []) [e1, e2]+    X.FloorMod -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::floormod" []) [e1, e2]+    X.CeilDiv -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::ceildiv" []) [e1, e2]+    X.CeilMod -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::ceilmod" []) [e1, e2]+    X.JustDiv -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::justdiv" []) [e1, e2]+    X.Pow -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::notmod::pow" []) [e1, e2]     -- advanced arithmetical functions-    X.Abs -> go01 $ \e -> Y.Call (Y.Function "std::abs" []) [e]-    X.Gcd -> go02 $ \e1 e2 -> Y.Call (Y.Function "std::gcd" []) [e1, e2]-    X.Lcm -> go02 $ \e1 e2 -> Y.Call (Y.Function "std::lcm" []) [e1, e2]-    X.Min2 -> go12 $ \t e1 e2 -> Y.Call (Y.Function "std::min" [t]) [e1, e2]-    X.Max2 -> go12 $ \t e1 e2 -> Y.Call (Y.Function "std::max" [t]) [e1, e2]+    X.Abs -> go01 $ \e -> Y.Call' (Y.Function "std::abs" []) [e]+    X.Gcd -> go02 $ \e1 e2 -> Y.Call' (Y.Function "std::gcd" []) [e1, e2]+    X.Lcm -> go02 $ \e1 e2 -> Y.Call' (Y.Function "std::lcm" []) [e1, e2]+    X.Min2 -> go12 $ \t e1 e2 -> Y.Call' (Y.Function "std::min" [t]) [e1, e2]+    X.Max2 -> go12 $ \t e1 e2 -> Y.Call' (Y.Function "std::max" [t]) [e1, e2]     X.Iterate -> go13'' $ runIterate env     -- logical functions     X.Not -> go01 $ \e -> Y.UnOp Y.Not e@@ -291,34 +342,34 @@     X.BitLeftShift -> go02 $ \e1 e2 -> Y.BinOp Y.BitLeftShift e1 e2     X.BitRightShift -> go02 $ \e1 e2 -> Y.BinOp Y.BitRightShift e1 e2     -- matrix functions-    X.MatAp h w -> go02 $ \f x -> Y.Call (Y.Function "jikka::mat::ap" [Y.TyIntValue h, Y.TyIntValue w]) [f, x]-    X.MatZero h w -> go00 $ Y.Call (Y.Function "jikka::mat::zero" [Y.TyIntValue h, Y.TyIntValue w]) []-    X.MatOne n -> go00 $ Y.Call (Y.Function "jikka::mat::one" [Y.TyIntValue n]) []-    X.MatAdd h w -> go02 $ \f g -> Y.Call (Y.Function "jikka::mat::add" [Y.TyIntValue h, Y.TyIntValue w]) [f, g]-    X.MatMul h n w -> go02 $ \f g -> Y.Call (Y.Function "jikka::mat::mul" [Y.TyIntValue h, Y.TyIntValue n, Y.TyIntValue w]) [f, g]-    X.MatPow n -> go02 $ \f k -> Y.Call (Y.Function "jikka::mat::pow" [Y.TyIntValue n]) [f, k]-    X.VecFloorMod n -> go02 $ \x m -> Y.Call (Y.Function "jikka::modmat::floormod" [Y.TyIntValue n]) [x, m]-    X.MatFloorMod h w -> go02 $ \f m -> Y.Call (Y.Function "jikka::modmat::floormod" [Y.TyIntValue h, Y.TyIntValue w]) [f, m]+    X.MatAp h w -> go02 $ \f x -> Y.Call' (Y.Function "jikka::mat::ap" [Y.TyIntValue h, Y.TyIntValue w]) [f, x]+    X.MatZero h w -> go00 $ Y.Call' (Y.Function "jikka::mat::zero" [Y.TyIntValue h, Y.TyIntValue w]) []+    X.MatOne n -> go00 $ Y.Call' (Y.Function "jikka::mat::one" [Y.TyIntValue n]) []+    X.MatAdd h w -> go02 $ \f g -> Y.Call' (Y.Function "jikka::mat::add" [Y.TyIntValue h, Y.TyIntValue w]) [f, g]+    X.MatMul h n w -> go02 $ \f g -> Y.Call' (Y.Function "jikka::mat::mul" [Y.TyIntValue h, Y.TyIntValue n, Y.TyIntValue w]) [f, g]+    X.MatPow n -> go02 $ \f k -> Y.Call' (Y.Function "jikka::mat::pow" [Y.TyIntValue n]) [f, k]+    X.VecFloorMod n -> go02 $ \x m -> Y.Call' (Y.Function "jikka::modmat::floormod" [Y.TyIntValue n]) [x, m]+    X.MatFloorMod h w -> go02 $ \f m -> Y.Call' (Y.Function "jikka::modmat::floormod" [Y.TyIntValue h, Y.TyIntValue w]) [f, m]     -- modular functions-    X.ModNegate -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::mod::negate" []) [e1, e2]-    X.ModPlus -> go03 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::mod::plus" []) [e1, e2, e3]-    X.ModMinus -> go03 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::mod::minus" []) [e1, e2, e3]-    X.ModMult -> go03 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::mod::mult" []) [e1, e2, e3]-    X.ModInv -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::mod::inv" []) [e1, e2]-    X.ModPow -> go03 $ \e1 e2 e3 -> Y.Call (Y.Function "jikka::mod::pow" []) [e1, e2, e3]-    X.ModMatAp h w -> go03 $ \f x m -> Y.Call (Y.Function "jikka::modmat::ap" [Y.TyIntValue h, Y.TyIntValue w]) [f, x, m]-    X.ModMatAdd h w -> go03 $ \f g m -> Y.Call (Y.Function "jikka::modmat::add" [Y.TyIntValue h, Y.TyIntValue w]) [f, g, m]-    X.ModMatMul h n w -> go03 $ \f g m -> Y.Call (Y.Function "jikka::modmat::mul" [Y.TyIntValue h, Y.TyIntValue n, Y.TyIntValue w]) [f, g, m]-    X.ModMatPow n -> go03 $ \f k m -> Y.Call (Y.Function "jikka::modmat::pow" [Y.TyIntValue n]) [f, k, m]+    X.ModNegate -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::mod::negate" []) [e1, e2]+    X.ModPlus -> go03 $ \e1 e2 e3 -> Y.Call' (Y.Function "jikka::mod::plus" []) [e1, e2, e3]+    X.ModMinus -> go03 $ \e1 e2 e3 -> Y.Call' (Y.Function "jikka::mod::minus" []) [e1, e2, e3]+    X.ModMult -> go03 $ \e1 e2 e3 -> Y.Call' (Y.Function "jikka::mod::mult" []) [e1, e2, e3]+    X.ModInv -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::mod::inv" []) [e1, e2]+    X.ModPow -> go03 $ \e1 e2 e3 -> Y.Call' (Y.Function "jikka::mod::pow" []) [e1, e2, e3]+    X.ModMatAp h w -> go03 $ \f x m -> Y.Call' (Y.Function "jikka::modmat::ap" [Y.TyIntValue h, Y.TyIntValue w]) [f, x, m]+    X.ModMatAdd h w -> go03 $ \f g m -> Y.Call' (Y.Function "jikka::modmat::add" [Y.TyIntValue h, Y.TyIntValue w]) [f, g, m]+    X.ModMatMul h n w -> go03 $ \f g m -> Y.Call' (Y.Function "jikka::modmat::mul" [Y.TyIntValue h, Y.TyIntValue n, Y.TyIntValue w]) [f, g, m]+    X.ModMatPow n -> go03 $ \f k m -> Y.Call' (Y.Function "jikka::modmat::pow" [Y.TyIntValue n]) [f, k, m]     -- list functions     X.Cons -> go12' $ \t x xs -> do-      ys <- Y.newFreshName Y.LocalNameKind+      ys <- Y.newFreshName LocalNameHint       useStatement $ Y.Declare (Y.TyVector t) ys Y.DeclareDefault       useStatement $ Y.callMethod' (Y.Var ys) "push_back" [x]       useStatement $ Y.callMethod' (Y.Var ys) "insert" [Y.end (Y.Var ys), Y.begin xs, Y.end xs]       return $ Y.Var ys     X.Snoc -> go12' $ \t xs x -> do-      ys <- Y.newFreshName Y.LocalNameKind+      ys <- Y.newFreshName LocalNameHint       useStatement $ Y.Declare (Y.TyVector t) ys (Y.DeclareCopy xs)       useStatement $ Y.callMethod' (Y.Var ys) "push_back" [x]       return $ Y.Var ys@@ -327,8 +378,8 @@       init <- runExpr env init       xs <- runExpr env xs       t2 <- runType t2-      ys <- Y.newFreshName Y.LocalNameKind-      i <- Y.newFreshName Y.LoopCounterNameKind+      ys <- Y.newFreshName LocalNameHint+      i <- Y.newFreshName LoopCounterNameHint       (stmtsF, body, f) <- runExprFunction2 env f (Y.at (Y.Var ys) (Y.Var i)) (Y.at xs (Y.Var i))       useStatement $ Y.Declare (Y.TyVector t2) ys (Y.DeclareCopy (Y.vecCtor t2 [Y.incrExpr (Y.size xs)]))       useStatement $ Y.assignAt ys (Y.litInt32 0) init@@ -339,8 +390,8 @@       xs <- runExpr env xs       n <- runExpr env n       t <- runType t-      ys <- Y.newFreshName Y.LocalNameKind-      i <- Y.newFreshName Y.LoopCounterNameKind+      ys <- Y.newFreshName LocalNameHint+      i <- Y.newFreshName LoopCounterNameHint       (stmtsF, body, f) <- runExprFunction env f (Y.Var ys)       useStatement $ Y.Declare (Y.TyVector t) ys (Y.DeclareCopy xs)       useStatements stmtsF@@ -351,104 +402,108 @@     X.Filter -> go12'' $ \t f xs -> do       xs <- runExpr env xs       t <- runType t-      ys <- Y.newFreshName Y.LocalNameKind-      x <- Y.newFreshName Y.LocalNameKind+      ys <- newFreshNameWithAdHocHintFromExpr "filtered" xs+      x <- Y.newFreshName LocalNameHint       (stmtsF, body, f) <- runExprFunction env f (Y.Var x)       useStatement $ Y.Declare (Y.TyVector t) ys Y.DeclareDefault       useStatements stmtsF       useStatement $ Y.ForEach t x xs (body ++ [Y.If f [Y.callMethod' (Y.Var ys) "push_back" [Y.Var x]] Nothing])       return $ Y.Var ys     X.At -> go12 $ \_ e1 e2 -> Y.at e1 e2-    X.SetAt -> go13 $ \t xs i x -> Y.Call (Y.SetAt t) [xs, i, x]+    X.SetAt -> go13 $ \t xs i x -> Y.Call' (Y.SetAt t) [xs, i, x]     X.Elem -> go12' $ \_ xs x -> do-      y <- Y.newFreshName Y.LocalNameKind+      y <- Y.newFreshName LocalNameHint       useStatement $ Y.Declare Y.TyBool y (Y.DeclareCopy (Y.BinOp Y.NotEqual (Y.callFunction "std::find" [] [Y.begin xs, Y.end xs, x]) (Y.end xs)))       return $ Y.Var y     X.Sum -> go01' $ \xs -> do-      y <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "sum" xs       useStatement $ Y.Declare Y.TyInt64 y (Y.DeclareCopy (Y.callFunction "std::accumulate" [] [Y.begin xs, Y.end xs, Y.litInt64 0]))       return $ Y.Var y     X.ModSum -> go02' $ \xs m -> do-      y <- Y.newFreshName Y.LocalNameKind-      x <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "sum" xs+      x <- Y.newFreshName LocalNameHint       useStatement $ Y.Declare Y.TyInt64 y (Y.DeclareCopy (Y.litInt64 0))       useStatement $ Y.ForEach Y.TyInt64 x xs [Y.Assign (Y.AssignExpr Y.AddAssign (Y.LeftVar y) (Y.callFunction "jikka::floormod" [] [Y.Var x, m]))]       return $ Y.callFunction "jikka::floormod" [] [Y.Var y, m]     X.Product -> go01' $ \xs -> do-      y <- Y.newFreshName Y.LocalNameKind-      x <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "prod" xs+      x <- Y.newFreshName LocalNameHint       useStatement $ Y.Declare Y.TyInt64 y (Y.DeclareCopy (Y.litInt64 1))       useStatement $ Y.ForEach Y.TyInt64 x xs [Y.Assign (Y.AssignExpr Y.MulAssign (Y.LeftVar y) (Y.Var x))]       return $ Y.Var y     X.ModProduct -> go02' $ \xs m -> do-      y <- Y.newFreshName Y.LocalNameKind-      x <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "prod" xs+      x <- Y.newFreshName LocalNameHint       useStatement $ Y.Declare Y.TyInt64 y (Y.DeclareCopy (Y.litInt64 1))       useStatement $ Y.ForEach Y.TyInt64 x xs [Y.Assign (Y.AssignExpr Y.SimpleAssign (Y.LeftVar y) (Y.callFunction "jikka::mod::mult" [] [Y.Var y, Y.Var x, m]))]       return $ Y.Var y     X.Min1 -> go11' $ \t xs -> do-      y <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "min" xs       useStatement $ Y.Declare t y (Y.DeclareCopy (Y.UnOp Y.Deref (Y.callFunction "std::min_element" [] [Y.begin xs, Y.end xs])))       return $ Y.Var y     X.Max1 -> go11' $ \t xs -> do-      y <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "max" xs       useStatement $ Y.Declare t y (Y.DeclareCopy (Y.UnOp Y.Deref (Y.callFunction "std::max_element" [] [Y.begin xs, Y.end xs])))       return $ Y.Var y     X.ArgMin -> go11' $ \t xs -> do-      y <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "argmin" xs       useStatement $ Y.Declare t y (Y.DeclareCopy (Y.BinOp Y.Sub (Y.callFunction "std::min_element" [] [Y.begin xs, Y.end xs]) (Y.begin xs)))       return $ Y.Var y     X.ArgMax -> go11' $ \t xs -> do-      y <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "argmax" xs       useStatement $ Y.Declare t y (Y.DeclareCopy (Y.BinOp Y.Sub (Y.callFunction "std::max_element" [] [Y.begin xs, Y.end xs]) (Y.begin xs)))       return $ Y.Var y     X.Gcd1 -> go11' $ \t xs -> do-      y <- Y.newFreshName Y.LocalNameKind-      useStatement $ Y.Declare t y (Y.DeclareCopy (Y.UnOp Y.Deref (Y.callFunction "std::accumulate" [] [Y.begin xs, Y.end xs, Y.litInt64 0, Y.Lam [(Y.TyAuto, Y.VarName "a"), (Y.TyAuto, Y.VarName "b")] Y.TyAuto [Y.Return $ Y.callFunction "std::gcd" [] [Y.Var $ Y.VarName "a", Y.Var $ Y.VarName "b"]]])))+      y <- newFreshNameWithAdHocHintFromExpr "gcd" xs+      a <- Y.newFreshName LocalArgumentNameHint+      b <- Y.newFreshName LocalArgumentNameHint+      useStatement $ Y.Declare t y (Y.DeclareCopy (Y.UnOp Y.Deref (Y.callFunction "std::accumulate" [] [Y.begin xs, Y.end xs, Y.litInt64 0, Y.Lam [(Y.TyAuto, a), (Y.TyAuto, b)] Y.TyAuto [Y.Return $ Y.callFunction "std::gcd" [] [Y.Var a, Y.Var b]]])))       return $ Y.Var y     X.Lcm1 -> go11' $ \t xs -> do-      y <- Y.newFreshName Y.LocalNameKind-      useStatement $ Y.Declare t y (Y.DeclareCopy (Y.UnOp Y.Deref (Y.callFunction "std::accumulate" [] [Y.begin xs, Y.end xs, Y.litInt64 1, Y.Lam [(Y.TyAuto, Y.VarName "a"), (Y.TyAuto, Y.VarName "b")] Y.TyAuto [Y.Return $ Y.callFunction "std::lcm" [] [Y.Var $ Y.VarName "a", Y.Var $ Y.VarName "b"]]])))+      y <- newFreshNameWithAdHocHintFromExpr "lcm" xs+      a <- Y.newFreshName LocalArgumentNameHint+      b <- Y.newFreshName LocalArgumentNameHint+      useStatement $ Y.Declare t y (Y.DeclareCopy (Y.UnOp Y.Deref (Y.callFunction "std::accumulate" [] [Y.begin xs, Y.end xs, Y.litInt64 1, Y.Lam [(Y.TyAuto, a), (Y.TyAuto, b)] Y.TyAuto [Y.Return $ Y.callFunction "std::lcm" [] [Y.Var a, Y.Var b]]])))       return $ Y.Var y     X.All -> go01' $ \xs -> do-      y <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "all" xs       useStatement $ Y.Declare Y.TyBool y (Y.DeclareCopy (Y.BinOp Y.Equal (Y.callFunction "std::find" [] [Y.begin xs, Y.end xs, Y.Lit (Y.LitBool False)]) (Y.end xs)))       return $ Y.Var y     X.Any -> go01' $ \xs -> do-      y <- Y.newFreshName Y.LocalNameKind+      y <- newFreshNameWithAdHocHintFromExpr "any" xs       useStatement $ Y.Declare Y.TyBool y (Y.DeclareCopy (Y.BinOp Y.NotEqual (Y.callFunction "std::find" [] [Y.begin xs, Y.end xs, Y.Lit (Y.LitBool True)]) (Y.end xs)))       return $ Y.Var y     X.Sorted -> go11' $ \t xs -> do-      ys <- Y.newFreshName Y.LocalNameKind+      ys <- newFreshNameWithAdHocHintFromExpr "sorted" xs       useStatement $ Y.Declare (Y.TyVector t) ys (Y.DeclareCopy xs)       useStatement $ Y.callFunction' "std::sort" [] [Y.begin (Y.Var ys), Y.end (Y.Var ys)]       return $ Y.Var ys     X.Reversed -> go11' $ \t xs -> do-      ys <- Y.newFreshName Y.LocalNameKind+      ys <- newFreshNameWithAdHocHintFromExpr "reversed" xs       useStatement $ Y.Declare (Y.TyVector t) ys (Y.DeclareCopy xs)       useStatement $ Y.callFunction' "std::reverse" [] [Y.begin (Y.Var ys), Y.end (Y.Var ys)]       return $ Y.Var ys-    X.Range1 -> go01 $ \n -> Y.Call Y.Range [n]+    X.Range1 -> go01 $ \n -> Y.Call' Y.Range [n]     X.Range2 -> go02' $ \from to -> do-      ys <- Y.newFreshName Y.LocalNameKind+      ys <- Y.newFreshName LocalNameHint       useStatement $ Y.Declare (Y.TyVector Y.TyInt64) ys (Y.DeclareCopy (Y.vecCtor Y.TyInt64 [Y.BinOp Y.Sub to from]))       useStatement $ Y.callFunction' "std::iota" [] [Y.begin (Y.Var ys), Y.end (Y.Var ys), from]       return $ Y.Var ys     X.Range3 -> go03' $ \from to step -> do-      ys <- Y.newFreshName Y.LocalNameKind-      i <- Y.newFreshName Y.LoopCounterNameKind+      ys <- Y.newFreshName LocalNameHint+      i <- Y.newFreshName LoopCounterNameHint       useStatement $ Y.Declare (Y.TyVector Y.TyInt64) ys Y.DeclareDefault       useStatement $ Y.For Y.TyInt32 i from (Y.BinOp Y.LessThan (Y.Var i) to) (Y.AssignExpr Y.AddAssign (Y.LeftVar i) step) [Y.callMethod' (Y.Var ys) "push_back" [Y.Var i]]       return $ Y.Var ys     -- tuple functions     X.Tuple -> goNN $ \ts es ->       if Y.shouldBeArray ts-        then Y.Call (Y.ArrayExt (head ts)) es-        else Y.Call (Y.StdTuple ts) es+        then Y.Call' (Y.ArrayExt (head ts)) es+        else Y.Call' (Y.StdTuple ts) es     X.Proj n -> goN1 $ \ts e ->       if Y.shouldBeArray ts         then Y.at e (Y.Lit (Y.LitInt32 n))-        else Y.Call (Y.StdGet (toInteger n)) [e]+        else Y.Call' (Y.StdGet (toInteger n)) [e]     -- comparison     X.LessThan -> go12 $ \_ e1 e2 -> Y.BinOp Y.LessThan e1 e2     X.LessEqual -> go12 $ \_ e1 e2 -> Y.BinOp Y.LessEqual e1 e2@@ -457,49 +512,49 @@     X.Equal -> go12 $ \_ e1 e2 -> Y.BinOp Y.Equal e1 e2     X.NotEqual -> go12 $ \_ e1 e2 -> Y.BinOp Y.NotEqual e1 e2     -- combinational functions-    X.Fact -> go01 $ \e -> Y.Call (Y.Function "jikka::notmod::fact" []) [e]-    X.Choose -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::notmod::choose" []) [e1, e2]-    X.Permute -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::notmod::permute" []) [e1, e2]-    X.MultiChoose -> go02 $ \e1 e2 -> Y.Call (Y.Function "jikka::notmod::multichoose" []) [e1, e2]+    X.Fact -> go01 $ \e -> Y.Call' (Y.Function "jikka::notmod::fact" []) [e]+    X.Choose -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::notmod::choose" []) [e1, e2]+    X.Permute -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::notmod::permute" []) [e1, e2]+    X.MultiChoose -> go02 $ \e1 e2 -> Y.Call' (Y.Function "jikka::notmod::multichoose" []) [e1, e2]     -- data structures-    X.ConvexHullTrickInit -> go00 $ Y.Call Y.ConvexHullTrickCtor []-    X.ConvexHullTrickGetMin -> go02 $ \cht x -> Y.Call (Y.Method "get_min") [cht, x]-    X.ConvexHullTrickInsert -> go03 $ \cht a b -> Y.Call Y.ConvexHullTrickCopyAddLine [cht, a, b]-    X.SegmentTreeInitList semigrp -> go01 $ \a -> Y.Call (Y.SegmentTreeCtor (runSemigroup semigrp)) [a]-    X.SegmentTreeGetRange _ -> go03 $ \segtree l r -> Y.Call (Y.Method "prod") [segtree, l, r]-    X.SegmentTreeSetPoint semigrp -> go03 $ \segtree i a -> Y.Call (Y.SegmentTreeCopySetPoint (runSemigroup semigrp)) [segtree, i, a]+    X.ConvexHullTrickInit -> go00 $ Y.Call' Y.ConvexHullTrickCtor []+    X.ConvexHullTrickGetMin -> go02 $ \cht x -> Y.Call' (Y.Method "get_min") [cht, x]+    X.ConvexHullTrickInsert -> go03 $ \cht a b -> Y.Call' Y.ConvexHullTrickCopyAddLine [cht, a, b]+    X.SegmentTreeInitList semigrp -> go01 $ \a -> Y.Call' (Y.SegmentTreeCtor (runSemigroup semigrp)) [a]+    X.SegmentTreeGetRange _ -> go03 $ \segtree l r -> Y.Call' (Y.Method "prod") [segtree, l, r]+    X.SegmentTreeSetPoint semigrp -> go03 $ \segtree i a -> Y.Call' (Y.SegmentTreeCopySetPoint (runSemigroup semigrp)) [segtree, i, a]  runExprFunction :: (MonadAlpha m, MonadError Error m) => Env -> X.Expr -> Y.Expr -> m ([Y.Statement], [Y.Statement], Y.Expr) runExprFunction env f e = case f of   X.Lam x t body -> do-    y <- renameVarName' Y.LocalArgumentNameKind x-    (stmts, body) <- runStatementsT $ runExpr ((x, t, y) : env) body+    y <- renameVarName' LocalArgumentNameHint x+    (stmts, body) <- runStatementsT $ runExpr (pushVar x t y env) body     let stmts' = map (Y.replaceStatement y e) stmts     let body' = Y.replaceExpr y e body     return ([], stmts', body')   f -> do     (stmts, f) <- runStatementsT $ runExpr env f-    return (stmts, [], Y.CallExpr f [e])+    return (stmts, [], Y.Call f [e])  runExprFunction2 :: (MonadAlpha m, MonadError Error m) => Env -> X.Expr -> Y.Expr -> Y.Expr -> m ([Y.Statement], [Y.Statement], Y.Expr) runExprFunction2 env f e1 e2 = case f of   X.Lam2 x1 t1 x2 t2 body -> do-    y1 <- renameVarName' Y.LocalArgumentNameKind x1-    y2 <- renameVarName' Y.LocalArgumentNameKind x2-    (stmts, body) <- runStatementsT $ runExpr ((x2, t2, y2) : (x1, t1, y1) : env) body+    y1 <- renameVarName' LocalArgumentNameHint x1+    y2 <- renameVarName' LocalArgumentNameHint x2+    (stmts, body) <- runStatementsT $ runExpr (pushVar x2 t2 y2 (pushVar x1 t1 y1 env)) body     let stmts' = map (Y.replaceStatement y2 e2 . Y.replaceStatement y1 e1) stmts     let body' = Y.replaceExpr y2 e2 $ Y.replaceExpr y1 e1 body     return ([], stmts', body')   f -> do     (stmts, f) <- runStatementsT $ runExpr env f-    return (stmts, [], Y.CallExpr (Y.CallExpr f [e1]) [e2])+    return (stmts, [], Y.Call (Y.Call f [e1]) [e2])  runAssert :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Expr -> m () runAssert env = \case   -- optimize @assert all(...)@   X.All' (X.Map' t _ f xs) -> do     t <- runType t-    y <- Y.newFreshName Y.LocalNameKind+    y <- Y.newFreshName LocalNameHint     xs <- runExpr env xs     (stmtsF, body, e) <- runExprFunction env f (Y.Var y)     useStatements stmtsF@@ -512,8 +567,11 @@ runExpr :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Expr -> m Y.Expr runExpr env = \case   X.Var x -> do-    y <- lookupVarName env x-    return $ Y.Var y+    case lookupVarName env x of+      Right y -> return $ Y.Var y+      Left _ -> case lookupFunName env x of+        Right f -> return $ Y.Callable (Y.Function f [])+        Left _ -> throwInternalError $ "undefined variable: " ++ X.formatVarName x   X.Lit lit -> do     runLiteral env lit   e@(X.App _ _) -> do@@ -527,7 +585,7 @@             ts <- mapM runType ts             ret <- runType ret             xs <- replicateM (arity - length args) X.genVarName'-            ys <- mapM (renameVarName' Y.LocalArgumentNameKind) xs+            ys <- mapM (renameVarName' LocalArgumentNameHint) xs             e <- runAppBuiltin env builtin bts (args ++ map X.Var xs)             let (_, e') = foldr (\(t, y) (ret, e) -> (Y.TyFunction ret [t], Y.Lam [(t, y)] ret [Y.Return e])) (ret, e) (zip (drop (length args) ts) ys)             return e'@@ -538,37 +596,37 @@               else do                 args' <- mapM (runExpr env) (drop arity args)                 e <- runAppBuiltin env builtin bts (take arity args)-                return $ Y.CallExpr e args'+                return $ Y.Call e args'       _ -> do         f <- runExpr env f         args <- mapM (runExpr env) args-        return $ Y.CallExpr f args+        return $ Y.Call f args   e@(X.Lam _ _ _) -> do     let (args, body) = X.uncurryLam e-    ys <- mapM (renameVarName' Y.LocalArgumentNameKind . fst) args-    let env' = reverse (zipWith (\(x, t) y -> (x, t, y)) args ys) ++ env+    ys <- mapM (renameVarName' LocalArgumentNameHint . fst) args+    let env' = foldl (\env ((x, t), y) -> pushVar x t y env) env (zip args ys)     ret <- runType =<< typecheckExpr env' body     (stmts, body) <- runStatementsT $ runExpr env' body     ts <- mapM (runType . snd) args     let (_, [Y.Return e]) = foldr (\(t, y) (ret, body) -> (Y.TyFunction ret [t], [Y.Return (Y.Lam [(t, y)] ret body)])) (ret, stmts ++ [Y.Return body]) (zip ts ys)     return e   X.Let x t e1 e2 -> do-    y <- renameVarName' Y.LocalNameKind x+    y <- renameVarName' LocalNameHint x     t' <- runType t     e1 <- runExpr env e1     useStatement $ Y.Declare t' y (Y.DeclareCopy e1)-    runExpr ((x, t, y) : env) e2+    runExpr (pushVar x t y env) e2   X.Assert e1 e2 -> do     runAssert env e1     runExpr env e2 -runToplevelFunDef :: (MonadAlpha m, MonadError Error m) => Env -> Y.VarName -> [(X.VarName, X.Type)] -> X.Type -> X.Expr -> m [Y.ToplevelStatement]+runToplevelFunDef :: (MonadAlpha m, MonadError Error m) => Env -> Y.FunName -> [(X.VarName, X.Type)] -> X.Type -> X.Expr -> m [Y.ToplevelStatement] runToplevelFunDef env f args ret body = do   ret <- runType ret   args <- forM args $ \(x, t) -> do-    y <- renameVarName' Y.ArgumentNameKind x+    y <- renameVarName' ArgumentNameHint x     return (x, t, y)-  (stmts, result) <- runStatementsT $ runExpr (reverse args ++ env) body+  (stmts, result) <- runStatementsT $ runExpr (foldl (\env (x, t, y) -> pushVar x t y env) env args) body   args <- forM args $ \(_, t, y) -> do     t <- runType t     return (t, y)@@ -580,41 +638,35 @@   (stmts, e) <- runStatementsT $ runExpr env e   case stmts of     [] -> return [Y.VarDef t x e]-    _ -> return [Y.VarDef t x (Y.CallExpr (Y.Lam [] t (stmts ++ [Y.Return e])) [])]+    _ -> return [Y.VarDef t x (Y.Call (Y.Lam [] t (stmts ++ [Y.Return e])) [])]  runToplevelExpr :: (MonadAlpha m, MonadError Error m) => Env -> X.ToplevelExpr -> m [Y.ToplevelStatement] runToplevelExpr env = \case   X.ResultExpr e -> do     t <- typecheckExpr env e-    case X.uncurryFunTy t of-      (ts@(_ : _), ret) -> do-        let f = Y.VarName "solve"-        (args, body) <- case X.uncurryLam e of-          (args, body) | length args == length ts -> do-            -- merge two sets of arguments which introduced by @FunTy@ and @Lam@-            args <- forM args $ \(x, t) -> do-              y <- renameVarName' Y.ArgumentNameKind x-              return (x, t, y)-            (stmts, e) <- runStatementsT $ runExpr (reverse args ++ env) body-            let body = stmts ++ [Y.Return e]-            args' <- forM args $ \(_, t, y) -> do-              t <- runType t-              return (t, y)-            return (args', body)-          _ -> do-            args <- forM ts $ \t -> do-              t <- runType t-              y <- Y.newFreshName Y.ArgumentNameKind-              return (t, y)-            (stmts, e) <- runStatementsT $ runExpr env e-            let body = stmts ++ [Y.Return (Y.CallExpr e (map (Y.Var . snd) args))]-            return (args, body)-        ret <- runType ret-        return [Y.FunDef ret f args body]+    (ts, ret) <- case X.uncurryFunTy t of+      (ts@(_ : _), ret) -> return (ts, ret)       _ -> throwInternalError "solve function must be a function" -- TODO: add check in restricted Python+    ret <- runType ret+    -- do eta-expansion to define it as a function.+    e <- X.etaExpand (typeEnv env) e+    (args, body) <- case X.uncurryLam e of+      (args, body) | length args == length ts -> return (args, body)+      _ -> throwInternalError "the result expr must be eta-converted"+    -- merge two sets of arguments which introduced by @FunTy@ and @Lam@+    args <- forM args $ \(x, t) -> do+      y <- renameVarName' ArgumentNameHint x+      return (x, t, y)+    (stmts, e) <- runStatementsT $ runExpr (foldl (\env (x, t, y) -> pushVar x t y env) env args) body+    let body = stmts ++ [Y.Return e]+    args' <- forM args $ \(_, t, y) -> do+      t <- runType t+      return (t, y)+    let f = Y.FunName "solve"+    return [Y.FunDef ret f args' body]   X.ToplevelLet x t e cont -> case (X.uncurryLam e, X.uncurryFunTy t) of     ((args@(_ : _), body), (ts@(_ : _), ret)) -> do-      g <- renameVarName' Y.FunctionNameKind x+      g <- renameFunName' x       (args, body) <-         if length args < length ts           then do@@ -623,28 +675,28 @@             let body' = X.uncurryApp body (map X.Var xs)             return (args', body')           else return (args, body)-      stmt <- runToplevelFunDef ((x, t, g) : env) g args ret body-      cont <- runToplevelExpr ((x, t, g) : env) cont+      stmt <- runToplevelFunDef (pushFun x t g env) g args ret body+      cont <- runToplevelExpr (pushFun x t g env) cont       return $ stmt ++ cont     _ -> do-      y <- renameVarName' Y.ConstantNameKind x+      y <- renameVarName' ConstantNameHint x       stmt <- runToplevelVarDef env y t e-      cont <- runToplevelExpr ((x, t, y) : env) cont+      cont <- runToplevelExpr (pushVar x t y env) cont       return $ stmt ++ cont   X.ToplevelLetRec f args ret body cont -> do-    g <- renameVarName' Y.FunctionNameKind f+    g <- renameFunName' f     let t = X.curryFunTy (map snd args) ret-    stmt <- runToplevelFunDef ((f, t, g) : env) g args ret body-    cont <- runToplevelExpr ((f, t, g) : env) cont+    stmt <- runToplevelFunDef (pushFun f t g env) g args ret body+    cont <- runToplevelExpr (pushFun f t g env) cont     return $ stmt ++ cont   X.ToplevelAssert e cont -> do     (stmts, e) <- runStatementsT $ runExpr env e-    let stmt = Y.StaticAssert (Y.CallExpr (Y.Lam [] Y.TyBool (stmts ++ [Y.Return e])) []) ""+    let stmt = Y.StaticAssert (Y.Call (Y.Lam [] Y.TyBool (stmts ++ [Y.Return e])) []) ""     cont <- runToplevelExpr env cont     return $ stmt : cont  runProgram :: (MonadAlpha m, MonadError Error m) => X.Program -> m Y.Program-runProgram prog = Y.Program <$> runToplevelExpr [] prog+runProgram prog = Y.Program <$> runToplevelExpr emptyEnv prog  run :: (MonadAlpha m, MonadError Error m) => X.Program -> m Y.Program run prog = wrapError' "Jikka.CPlusPlus.Convert.FromCore" $ do

@@ -19,13 +19,14 @@ import Jikka.CPlusPlus.Language.Util import Jikka.Common.Alpha import Jikka.Common.Error+import Jikka.Common.Name  runExpr :: (MonadAlpha m, MonadWriter [Statement] m) => Expr -> m Expr runExpr = \case-  Call (SetAt t) [xs, i, x] -> do+  Call' (SetAt t) [xs, i, x] -> do     y <- case xs of-      Var (VarName xs) -> renameVarName LocalNameKind xs-      _ -> newFreshName LocalNameKind+      Var xs -> renameVarName LocalNameHint xs+      _ -> newFreshName LocalNameHint     tell       [ Declare (TyVector t) y (DeclareCopy xs),         Assign (AssignExpr SimpleAssign (LeftAt (LeftVar y) i) x)

@@ -34,8 +34,8 @@   BinOp op e1 e2 -> BinOp op <$> runExpr e1 <*> runExpr e2   Cond e1 e2 e3 -> Cond <$> runExpr e1 <*> runExpr e2 <*> runExpr e3   Lam args ret body -> Lam args ret <$> runStatements body []-  Call f args -> Call f <$> mapM runExpr args-  CallExpr f args -> CallExpr <$> runExpr f <*> mapM runExpr args+  Call f args -> Call <$> runExpr f <*> mapM runExpr args+  Callable f -> return $ Callable f  runLeftExpr :: MonadState (M.Map VarName VarName) m => LeftExpr -> m LeftExpr runLeftExpr = \case@@ -120,16 +120,16 @@       DeclareCopy (Var x) | (x `isMovableTo` y) SimpleCopy env cont -> do         modify' (M.insert y x)         return []-      DeclareCopy (Call (SetAt _) [Var x, i, xi])+      DeclareCopy (Call' (SetAt _) [Var x, i, xi])         | (x `isMovableTo` y) UpdatedCopy env cont -> do           modify' (M.insert y x)           return [Assign (AssignExpr SimpleAssign (LeftAt (LeftVar x) i) xi)]-      DeclareCopy (Call ConvexHullTrickCtor []) -> return [Declare t y DeclareDefault]-      DeclareCopy (Call ConvexHullTrickCopyAddLine [Var x, a, b])+      DeclareCopy (Call' ConvexHullTrickCtor []) -> return [Declare t y DeclareDefault]+      DeclareCopy (Call' ConvexHullTrickCopyAddLine [Var x, a, b])         | (x `isMovableTo` y) UpdatedCopy env cont -> do           modify' (M.insert y x)           return [callMethod' (Var x) "add_line" [a, b]]-      DeclareCopy (Call (SegmentTreeCopySetPoint _) [Var x, i, a])+      DeclareCopy (Call' (SegmentTreeCopySetPoint _) [Var x, i, a])         | (x `isMovableTo` y) UpdatedCopy env cont -> do           modify' (M.insert y x)           return [callMethod' (Var x) "set" [i, a]]@@ -143,19 +143,19 @@     env <- get     case e of       AssignExpr SimpleAssign (LeftVar y) (Var x) | x == y -> return []-      AssignExpr SimpleAssign (LeftVar y) (Call (SetAt _) [Var x, i, xi])+      AssignExpr SimpleAssign (LeftVar y) (Call' (SetAt _) [Var x, i, xi])         | x == y -> return [Assign (AssignExpr SimpleAssign (LeftAt (LeftVar x) i) xi)]         | (x `isMovableTo` y) UpdatedCopy env cont -> do           modify' (M.insert y x)           return [Assign (AssignExpr SimpleAssign (LeftAt (LeftVar x) i) xi)]         | otherwise -> return [Assign e]-      AssignExpr SimpleAssign (LeftVar y) (Call ConvexHullTrickCopyAddLine [Var x, a, b])+      AssignExpr SimpleAssign (LeftVar y) (Call' ConvexHullTrickCopyAddLine [Var x, a, b])         | x == y -> return [callMethod' (Var x) "add_line" [a, b]]         | (x `isMovableTo` y) UpdatedCopy env cont -> do           modify' (M.insert y x)           return [callMethod' (Var x) "add_line" [a, b]]         | otherwise -> return [Assign e]-      AssignExpr SimpleAssign (LeftVar y) (Call (SegmentTreeCopySetPoint _) [Var x, i, a])+      AssignExpr SimpleAssign (LeftVar y) (Call' (SegmentTreeCopySetPoint _) [Var x, i, a])         | x == y -> return [callMethod' (Var x) "set" [i, a]]         | (x `isMovableTo` y) UpdatedCopy env cont -> do           modify' (M.insert y x)

@@ -16,20 +16,25 @@  import Jikka.CPlusPlus.Language.Expr import Jikka.CPlusPlus.Language.Util+import Jikka.Common.Alpha import Jikka.Common.Error+import Jikka.Common.Name  runExpr :: Monad m => Expr -> m Expr runExpr = \case-  Call At [Call Range [_], i] -> return i-  Call MethodSize [Call Range [n]] -> return n+  Call' At [Call' Range [_], i] -> return i+  Call' MethodSize [Call' Range [n]] -> return n   e -> return e -runStatement :: Monad m => Statement -> m Statement+runStatement :: MonadAlpha m => Statement -> m Statement runStatement = \case-  ForEach _ x (Call Range [n]) body -> return $ repStatement x n body -- TODO: check n is not updated in body+  ForEach _ x (Call' Range [n]) body -> do+    y <- renameVarName LoopCounterNameHint x+    let body' = map (renameVarNameStatement x y) body+    return $ repStatement y n body' -- TODO: check n is not updated in body   stmt -> return stmt -runProgram :: Monad m => Program -> m Program+runProgram :: MonadAlpha m => Program -> m Program runProgram = mapExprStatementProgramM runExpr (((: []) <$>) . runStatement)  -- | `run` replaces superfluous copying.@@ -55,6 +60,6 @@ -- > for (int i = 0; i < n; ++ i) { -- >     ... -- > }-run :: MonadError Error m => Program -> m Program+run :: (MonadAlpha m, MonadError Error m) => Program -> m Program run prog = wrapError' "Jikka.CPlusPlus.Convert.OptimizeRange" $ do   runProgram prog

@@ -21,6 +21,7 @@ import Jikka.CPlusPlus.Language.Util import Jikka.Common.Alpha import Jikka.Common.Error+import Jikka.Common.Name  -- | `runExpr` replaces variables using the @mapping :: M.Map VarName [(Type, VarName)]@. runExpr :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, VarName)]) m) => Expr -> m Expr@@ -34,17 +35,19 @@          in if shouldBeArray (map fst ys)               then                 let t = fst (head ys)-                 in Call (ArrayExt t) es+                 in Call' (ArrayExt t) es               else                 let ts = map fst ys-                 in Call (StdTuple ts) es+                 in Call' (StdTuple ts) es   Lit lit -> return $ Lit lit   UnOp op e -> UnOp op <$> runExpr e   BinOp op e1 e2 -> BinOp op <$> runExpr e1 <*> runExpr e2   Cond e1 e2 e3 -> Cond <$> runExpr e1 <*> runExpr e2 <*> runExpr e3   Lam args ret body -> Lam args ret <$> runStatements body []-  Call f args -> runCall f args-  CallExpr e args -> CallExpr <$> runExpr e <*> mapM runExpr args+  Call f args -> case f of+    Callable f -> runCall f args+    _ -> Call <$> runExpr f <*> mapM runExpr args+  Callable f -> return $ Callable f  -- | `runCall` does the same thing to `runExpr` and also reduces `std::get<i>(e)` and `e[i]`. runCall :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, VarName)]) m) => Function -> [Expr] -> m Expr@@ -60,9 +63,9 @@           when (n < 0 || toInteger (length ys) <= n) $ do             throwInternalError "index out of range"           return $ es !! fromInteger n-        Nothing -> return $ Call f args+        Nothing -> return $ Call' f args     -- std::get<n>(std::tuple<T1, T2, ...>(e1, e2, ...))-    (StdGet n, [Call (StdTuple _) es]) -> do+    (StdGet n, [Call' (StdTuple _) es]) -> do       when (n < 0 || toInteger (length es) <= n) $ do         throwInternalError "index out of range"       return $ es !! fromInteger n@@ -81,10 +84,10 @@               when (n < 0 || toInteger (length ys) <= n) $ do                 throwInternalError "index out of range"               return (es !! fromInteger n)-            Nothing -> return $ Call f args-        Nothing -> return $ Call f args+            Nothing -> return $ Call' f args+        Nothing -> return $ Call' f args     -- (std::array<T, n>{e1, e2, ...})[i]-    (At, [Call (ArrayExt _) es, e2]) -> do+    (At, [Call' (ArrayExt _) es, e2]) -> do       let n = case e2 of             Lit (LitInt32 n) -> Just n             Lit (LitInt64 n) -> Just n@@ -94,8 +97,8 @@           when (n < 0 || toInteger (length es) <= n) $ do             throwInternalError "index out of range"           return (es !! fromInteger n)-        Nothing -> return $ Call f args-    _ -> return $ Call f args+        Nothing -> return $ Call' f args+    _ -> return $ Call' f args  runLeftExpr :: (MonadAlpha m, MonadError Error m, MonadState (M.Map VarName [(Type, VarName)]) m) => LeftExpr -> m LeftExpr runLeftExpr = \case@@ -143,14 +146,14 @@       DeclareInitialize es -> DeclareInitialize <$> mapM runExpr es     case init of       -- std::tuple<T1, T2, ...> x = std::tuple<...>(e1, e2, ...);-      DeclareCopy (Call (StdTuple ts) es) -> do-        ys <- replicateM (length es) (renameVarName LocalNameKind (unVarName x))+      DeclareCopy (Call' (StdTuple ts) es) -> do+        ys <- replicateM (length es) (renameVarName LocalNameHint x)         modify' (M.insert x (zip ts ys))         return $ zipWith3 (\t y e -> Declare t y (DeclareCopy e)) ts ys es       -- std::array<T, n> x = std::array<T, n>{e1, e2, ...};-      DeclareCopy (Call (ArrayExt t) es) -> do+      DeclareCopy (Call' (ArrayExt t) es) -> do         let ts = replicate (length es) t-        ys <- replicateM (length es) (renameVarName LocalNameKind (unVarName x))+        ys <- replicateM (length es) (renameVarName LocalNameHint x)         modify' (M.insert x (zip ts ys))         return $ zipWith3 (\t y e -> Declare t y (DeclareCopy e)) ts ys es       _ -> do@@ -169,20 +172,20 @@             let ts = map fst ys             let n = toInteger (length ts)             let es = case e of-                  Call (StdTuple _) es -> es-                  Call (ArrayExt _) es -> es+                  Call' (StdTuple _) es -> es+                  Call' (ArrayExt _) es -> es                   _ ->                     if shouldBeArray ts-                      then map (\i -> Call At [e, litInt32 i]) [0 .. n - 1]-                      else map (\i -> Call (StdGet i) [e]) [0 .. n - 1]-            tmpys <- replicateM (length ts) (newFreshName LocalNameKind)+                      then map (\i -> Call' At [e, litInt32 i]) [0 .. n - 1]+                      else map (\i -> Call' (StdGet i) [e]) [0 .. n - 1]+            tmpys <- replicateM (length ts) (newFreshName LocalNameHint)             return $ zipWith3 (\t y e -> Declare t y (DeclareCopy e)) ts tmpys es ++ zipWith (\y e -> Assign (AssignExpr SimpleAssign (LeftVar y) (Var e))) (map snd ys) tmpys           Nothing -> return [Assign (AssignExpr SimpleAssign (LeftVar x) e)]       _ -> do         forM_ (S.toList (freeVarsAssignExpr e)) $ \x -> do           ys <- gets (M.lookup x)           case ys of-            Just _ -> throwInternalError $ "wrong assignment to a tuple: " ++ unVarName x+            Just _ -> throwInternalError $ "wrong assignment to a tuple: " ++ formatVarName x             Nothing -> return ()         return [Assign e]   Assert e -> do

@@ -22,10 +22,10 @@ runStatement :: Statement -> Statement runStatement = \case   Declare t x init -> case (t, init) of-    (TyVector _, DeclareCopy (Call (VecCtor _) [])) -> Declare t x DeclareDefault-    (TyVector _, DeclareCopy (Call (VecCtor _) es)) -> Declare t x (DeclareInitialize es)-    (TyConvexHullTrick, DeclareCopy (Call ConvexHullTrickCtor es)) -> Declare t x (DeclareInitialize es)-    (TySegmentTree _, DeclareCopy (Call (SegmentTreeCtor _) es)) -> Declare t x (DeclareInitialize es)+    (TyVector _, DeclareCopy (Call' (VecCtor _) [])) -> Declare t x DeclareDefault+    (TyVector _, DeclareCopy (Call' (VecCtor _) es)) -> Declare t x (DeclareInitialize es)+    (TyConvexHullTrick, DeclareCopy (Call' ConvexHullTrickCtor es)) -> Declare t x (DeclareInitialize es)+    (TySegmentTree _, DeclareCopy (Call' (SegmentTreeCtor _) es)) -> Declare t x (DeclareInitialize es)     (_, _) -> Declare t x init   stmt -> stmt 

@@ -204,9 +204,45 @@ formatExpr' :: Prec -> Expr -> Code formatExpr' prec = resolvePrec prec . formatExpr +formatFunction :: Function -> Maybe [Expr] -> (Code, Prec)+formatFunction f args =+  let args' = intercalate ", " (maybe [] (map (formatExpr' CommaPrec)) args)+      call f = case args of+        Nothing -> (f, IdentPrec)+        Just _ -> (f ++ "(" ++ args' ++ ")", FunCallPrec)+      method f = case args of+        Just (e : args) -> (formatExpr' FunCallPrec e ++ "." ++ f ++ "(" ++ intercalate ", " (map (formatExpr' CommaPrec) args) ++ ")", FunCallPrec)+        _ -> error $ "Jikka.CPlusPlus.Language.Format.formatExpr: no receiver for method: " ++ f+   in case f of+        Function f ts -> call $ formatFunName f ++ (if null ts then "" else "<" ++ intercalate ", " (map formatType ts) ++ ">")+        Method f -> method $ formatFunName f+        At -> case args of+          Just [e1, e2] ->+            let e1' = formatExpr' FunCallPrec e1+                e2' = formatExpr' ParenPrec e2+             in (e1' ++ "[" ++ e2' ++ "]", FunCallPrec)+          _ -> error $ "Jikka.CPlusPlus.Language.Format.formatExpr: wrong number of arguments for subscription: " ++ show (length args)+        SetAt t -> call $ "jikka::set_at<" ++ formatType t ++ ">"+        Cast t -> call $ formatType t+        StdTuple ts -> call $ "std::tuple<" ++ intercalate ", " (map formatType ts) ++ ">"+        StdGet n -> call $ "std::get<" ++ show n ++ ">"+        ArrayExt t -> case args of+          Nothing -> error "cannot use array extensional notation without any application"+          Just args -> ("std::array<" ++ formatType t ++ ", " ++ show (length args) ++ ">{" ++ args' ++ "}", IdentPrec)+        VecExt t -> case args of+          Nothing -> error "cannot use vector extensional notation without any application"+          Just _ -> ("std::vector<" ++ formatType t ++ ">{" ++ args' ++ "}", IdentPrec)+        VecCtor t -> call $ "std::vector<" ++ formatType t ++ ">"+        Range -> call "jikka::range"+        MethodSize -> method "size"+        ConvexHullTrickCtor -> call "jikka::convex_hull_trick"+        ConvexHullTrickCopyAddLine -> call "jikka::convex_hull_trick::add_line"+        SegmentTreeCtor mon -> call (formatType (TySegmentTree mon))+        SegmentTreeCopySetPoint _ -> call "jikka::segment_tree_set"+ formatExpr :: Expr -> (Code, Prec) formatExpr = \case-  Var x -> (unVarName x, IdentPrec)+  Var x -> (formatVarName x, IdentPrec)   Lit lit -> (formatLiteral lit, IdentPrec)   UnOp op e ->     let (op', prec) = formatUnaryOp op@@ -218,42 +254,17 @@         e2' = resolvePrecRight prec (formatExpr e2)      in (e1' ++ " " ++ op' ++ " " ++ e2', prec)   Lam args ret body ->-    let args' = map (\(t, x) -> formatType t ++ " " ++ unVarName x) args+    let args' = map (\(t, x) -> formatType t ++ " " ++ formatVarName x) args         ret' = formatType ret         body' = concatMap formatStatement body      in ("[=](" ++ intercalate ", " args' ++ ") -> " ++ ret' ++ "{ " ++ unwords body' ++ " }", FunCallPrec)-  Call f args ->-    let args' = intercalate ", " (map (formatExpr' CommaPrec) args)-        call f = (f ++ "(" ++ args' ++ ")", FunCallPrec)-        method f = case args of-          [] -> error $ "Jikka.CPlusPlus.Language.Format.formatExpr: no receiver for method: " ++ f-          e : args -> (formatExpr' FunCallPrec e ++ "." ++ f ++ "(" ++ intercalate ", " (map (formatExpr' CommaPrec) args) ++ ")", FunCallPrec)-     in case f of-          Function f ts -> call $ unFunName f ++ (if null ts then "" else "<" ++ intercalate ", " (map formatType ts) ++ ">")-          Method f -> method $ unFunName f-          At -> case args of-            [e1, e2] ->-              let e1' = formatExpr' FunCallPrec e1-                  e2' = formatExpr' ParenPrec e2-               in (e1' ++ "[" ++ e2' ++ "]", FunCallPrec)-            _ -> error $ "Jikka.CPlusPlus.Language.Format.formatExpr: wrong number of arguments for subscription: " ++ show (length args)-          SetAt t -> call $ "jikka::set_at<" ++ formatType t ++ ">"-          Cast t -> call $ formatType t-          StdTuple ts -> call $ "std::tuple<" ++ intercalate ", " (map formatType ts) ++ ">"-          StdGet n -> call $ "std::get<" ++ show n ++ ">"-          ArrayExt t -> ("std::array<" ++ formatType t ++ ", " ++ show (length args) ++ ">{" ++ args' ++ "}", IdentPrec)-          VecExt t -> ("std::vector<" ++ formatType t ++ ">{" ++ args' ++ "}", IdentPrec)-          VecCtor t -> call $ "std::vector<" ++ formatType t ++ ">"-          Range -> call "jikka::range"-          MethodSize -> method "size"-          ConvexHullTrickCtor -> call "jikka::convex_hull_trick"-          ConvexHullTrickCopyAddLine -> call "jikka::convex_hull_trick::add_line"-          SegmentTreeCtor mon -> call (formatType (TySegmentTree mon))-          SegmentTreeCopySetPoint _ -> call "jikka::segment_tree_set"-  CallExpr f args ->-    let f' = formatExpr' FunCallPrec f-        args' = intercalate ", " (map (formatExpr' CommaPrec) args)-     in (f' ++ "(" ++ args' ++ ")", FunCallPrec)+  Call f args -> case f of+    Callable f -> formatFunction f (Just args)+    _ -> do+      let f' = formatExpr' FunCallPrec f+          args' = intercalate ", " (map (formatExpr' CommaPrec) args)+       in (f' ++ "(" ++ args' ++ ")", FunCallPrec)+  Callable f -> formatFunction f Nothing   Cond e1 e2 e3 ->     let e1' = resolvePrecLeft CondPrec (formatExpr e1)         e2' = resolvePrec CondPrec (formatExpr e2)@@ -291,12 +302,12 @@         cond' = formatExpr' ParenPrec cond         incr' = resolvePrec ParenPrec $ formatAssignExpr incr         body' = concatMap formatStatement body-     in ["for (" ++ t' ++ " " ++ unVarName x ++ " = " ++ init' ++ "; " ++ cond' ++ "; " ++ incr' ++ ") {"] ++ body' ++ ["}"]+     in ["for (" ++ t' ++ " " ++ formatVarName x ++ " = " ++ init' ++ "; " ++ cond' ++ "; " ++ incr' ++ ") {"] ++ body' ++ ["}"]   ForEach t x xs body ->     let t' = formatType t         xs' = formatExpr' ParenPrec xs         body' = concatMap formatStatement body-     in ["for (" ++ t' ++ " " ++ unVarName x ++ " : " ++ xs' ++ ") {"] ++ body' ++ ["}"]+     in ["for (" ++ t' ++ " " ++ formatVarName x ++ " : " ++ xs' ++ ") {"] ++ body' ++ ["}"]   While cond body ->     let cond' = formatExpr' ParenPrec cond         body' = concatMap formatStatement body@@ -307,20 +318,20 @@           DeclareDefault -> ""           DeclareCopy e -> " = " ++ resolvePrecRight AssignPrec (formatExpr e)           DeclareInitialize es -> "(" ++ intercalate ", " (map (formatExpr' CommaPrec) es) ++ ")"-     in [t' ++ " " ++ unVarName x ++ init' ++ ";"]-  DeclareDestructure xs e -> ["auto [" ++ intercalate ", " (map unVarName xs) ++ "] = " ++ resolvePrecRight AssignPrec (formatExpr e) ++ ";"]+     in [t' ++ " " ++ formatVarName x ++ init' ++ ";"]+  DeclareDestructure xs e -> ["auto [" ++ intercalate ", " (map formatVarName xs) ++ "] = " ++ resolvePrecRight AssignPrec (formatExpr e) ++ ";"]   Assign e -> [resolvePrec ParenPrec (formatAssignExpr e) ++ ";"]   Assert e -> ["assert (" ++ formatExpr' ParenPrec e ++ ");"]   Return e -> ["return " ++ formatExpr' ParenPrec e ++ ";"]  formatToplevelStatement :: ToplevelStatement -> [Code] formatToplevelStatement = \case-  VarDef t x e -> [formatType t ++ " " ++ unVarName x ++ " = " ++ resolvePrecRight AssignPrec (formatExpr e) ++ ";"]+  VarDef t x e -> [formatType t ++ " " ++ formatVarName x ++ " = " ++ resolvePrecRight AssignPrec (formatExpr e) ++ ";"]   FunDef ret f args body ->     let ret' = formatType ret-        args' = intercalate ", " $ map (\(t, x) -> formatType t ++ " " ++ unVarName x) args+        args' = intercalate ", " $ map (\(t, x) -> formatType t ++ " " ++ formatVarName x) args         body' = concatMap formatStatement body-     in [ret' ++ " " ++ unVarName f ++ "(" ++ args' ++ ") {"] ++ body' ++ ["}"]+     in [ret' ++ " " ++ formatFunName f ++ "(" ++ args' ++ ") {"] ++ body' ++ ["}"]   StaticAssert e msg ->     ["static_assert (" ++ resolvePrec CommaPrec (formatExpr e) ++ ", " ++ formatLiteral (LitString msg) ++ ");"] 

@@ -1,5 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}- -- | -- Module      : Jikka.CPlusPlus.Language.Expr -- Description : contains data types of C++ language. / C++ のためのデータ型を含みます。@@ -13,12 +11,27 @@ -- The data types are intended to use for the code generation. module Jikka.CPlusPlus.Language.Expr where -import Data.String (IsString)+import Data.String+import Jikka.Common.Name -newtype VarName = VarName {unVarName :: String} deriving (Eq, Ord, Show, Read, IsString)+data VarName = VarName OccName NameFlavour (Maybe NameHint) deriving (Eq, Ord, Show, Read) -newtype FunName = FunName {unFunName :: String} deriving (Eq, Ord, Show, Read, IsString)+instance IsString VarName where+  fromString s =+    let (occ, flavour) = toFlavouredName s+     in VarName occ flavour Nothing +formatVarName :: VarName -> String+formatVarName (VarName occ flavour _) = formatFlavouredName occ flavour++newtype FunName = FunName String deriving (Eq, Ord, Show, Read)++instance IsString FunName where+  fromString = FunName++formatFunName :: FunName -> String+formatFunName (FunName occ) = occ+ data Type   = -- | @auto@     TyAuto@@ -192,10 +205,9 @@     Cond Expr Expr Expr   | -- | lambda expression @[=](T1 x1, T2 x2, ...) -> Tr { stmt1; stmt2; ... }@     Lam [(Type, VarName)] Type [Statement]-  | -- | @f(e1, e2, ...)@ for a fixed function @f@-    Call Function [Expr]-  | -- | @e(e1, e2, ...)@ for an callable expr @e@-    CallExpr Expr [Expr]+  | -- | @f(e1, e2, ...)@ for a callable @f@+    Call Expr [Expr]+  | Callable Function   deriving (Eq, Ord, Show, Read)  data LeftExpr@@ -254,7 +266,7 @@   = -- | @const T x = e;@     VarDef Type VarName Expr   | -- | @T f(T1 x1, T2 x2, ...) { stmt1; stmt2; ... }@-    FunDef Type VarName [(Type, VarName)] [Statement]+    FunDef Type FunName [(Type, VarName)] [Statement]   | -- | @static_assert(e, msg);@     StaticAssert Expr String   deriving (Eq, Ord, Show, Read)

@@ -1,49 +1,37 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}  module Jikka.CPlusPlus.Language.Util where  import Control.Monad.Identity-import Data.Char (isAlphaNum, isNumber) import qualified Data.Set as S import Jikka.CPlusPlus.Language.Expr import Jikka.Common.Alpha+import Jikka.Common.Name  fromLeftExpr :: LeftExpr -> Expr fromLeftExpr = \case   LeftVar x -> Var x-  LeftAt x e -> Call At [fromLeftExpr x, e]-  LeftGet n e -> Call (Function "std::get" [TyIntValue n]) [fromLeftExpr e]--data NameKind-  = LocalNameKind-  | LocalArgumentNameKind-  | LoopCounterNameKind-  | ConstantNameKind-  | FunctionNameKind-  | ArgumentNameKind-  deriving (Eq, Ord, Show, Read)+  LeftAt x e -> Call' At [fromLeftExpr x, e]+  LeftGet n e -> Call' (Function "std::get" [TyIntValue n]) [fromLeftExpr e] -fromNameKind :: NameKind -> String-fromNameKind = \case-  LocalNameKind -> "x"-  LocalArgumentNameKind -> "b"-  LoopCounterNameKind -> "i"-  ConstantNameKind -> "c"-  FunctionNameKind -> "f"-  ArgumentNameKind -> "a"+newFreshName :: MonadAlpha m => NameHint -> m VarName+newFreshName kind = do+  i <- nextCounter+  return (VarName Nothing (Just i) (Just kind)) -newFreshName :: MonadAlpha m => NameKind -> m VarName-newFreshName kind = renameVarName kind ""+renameVarName :: MonadAlpha m => NameHint -> VarName -> m VarName+renameVarName kind (VarName occ _ _) = case occ of+  Nothing -> newFreshName kind+  Just occ -> renameVarName' kind occ -renameVarName :: MonadAlpha m => NameKind -> String -> m VarName-renameVarName kind hint = do+renameVarName' :: MonadAlpha m => NameHint -> String -> m VarName+renameVarName' kind occ = do   i <- nextCounter-  let f = reverse . dropWhile (\c -> isNumber c || c == '_') . reverse . takeWhile (\c -> isAlphaNum c || c == '_')-  let prefix = case f hint of-        "" -> fromNameKind kind-        hint' -> hint' ++ "_"-  return (VarName (prefix ++ show i))+  return (VarName (Just occ) (Just i) (Just kind))  freeVars :: Expr -> S.Set VarName freeVars = \case@@ -53,8 +41,8 @@   BinOp _ e1 e2 -> freeVars e1 <> freeVars e2   Cond e1 e2 e3 -> freeVars e1 <> freeVars e2 <> freeVars e3   Lam args _ body -> freeVarsStatements body S.\\ S.fromList (map snd args)-  Call _ args -> mconcat (map freeVars args)-  CallExpr f args -> freeVars f <> mconcat (map freeVars args)+  Call f args -> freeVars f <> mconcat (map freeVars args)+  Callable _ -> S.empty  freeVarsStatements :: [Statement] -> S.Set VarName freeVarsStatements = mconcat . map freeVarsStatement@@ -112,14 +100,17 @@ incrExpr :: Expr -> Expr incrExpr e = BinOp Add e (Lit (LitInt32 1)) +pattern Call' :: Function -> [Expr] -> Expr+pattern Call' f args = Call (Callable f) args+ size :: Expr -> Expr-size e = Call MethodSize [e]+size e = Call' MethodSize [e]  at :: Expr -> Expr -> Expr-at e i = Call At [e, i]+at e i = Call' At [e, i]  cast :: Type -> Expr -> Expr-cast t e = Call (Cast t) [e]+cast t e = Call' (Cast t) [e]  assignSimple :: VarName -> Expr -> Statement assignSimple x e = Assign (AssignExpr SimpleAssign (LeftVar x) e)@@ -128,25 +119,25 @@ assignAt xs i e = Assign (AssignExpr SimpleAssign (LeftAt (LeftVar xs) i) e)  callFunction :: FunName -> [Type] -> [Expr] -> Expr-callFunction f ts args = Call (Function f ts) args+callFunction f ts args = Call' (Function f ts) args  callFunction' :: FunName -> [Type] -> [Expr] -> Statement callFunction' = ((ExprStatement .) .) . callFunction  callMethod :: Expr -> FunName -> [Expr] -> Expr-callMethod e f args = Call (Method f) (e : args)+callMethod e f args = Call' (Method f) (e : args)  callMethod' :: Expr -> FunName -> [Expr] -> Statement callMethod' = ((ExprStatement .) .) . callMethod  vecCtor :: Type -> [Expr] -> Expr-vecCtor t es = Call (VecCtor t) es+vecCtor t es = Call' (VecCtor t) es  begin :: Expr -> Expr-begin e = Call (Method "begin") [e]+begin e = Call' (Method "begin") [e]  end :: Expr -> Expr-end e = Call (Method "end") [e]+end e = Call' (Method "end") [e]  mapExprStatementExprM :: Monad m => (Expr -> m Expr) -> (Statement -> m [Statement]) -> Expr -> m Expr mapExprStatementExprM f g = go@@ -158,8 +149,8 @@       BinOp op e1 e2 -> f =<< (BinOp op <$> go e1 <*> go e2)       Cond e1 e2 e3 -> f =<< (Cond <$> go e1 <*> go e2 <*> go e3)       Lam args ret body -> f . Lam args ret . concat =<< mapM (mapExprStatementStatementM f g) body-      Call g args -> f . Call g =<< mapM go args-      CallExpr g args -> f =<< (CallExpr <$> go g <*> mapM go args)+      Call g args -> f =<< (Call <$> go g <*> mapM go args)+      Callable g -> f $ Callable g  mapExprStatementLeftExprM :: Monad m => (Expr -> m Expr) -> (Statement -> m [Statement]) -> LeftExpr -> m LeftExpr mapExprStatementLeftExprM f g = \case@@ -208,6 +199,9 @@ mapExprStatementProgram :: (Expr -> Expr) -> (Statement -> [Statement]) -> Program -> Program mapExprStatementProgram f g = runIdentity . mapExprStatementProgramM (return . f) (return . g) +mapExprStatementExpr :: (Expr -> Expr) -> (Statement -> [Statement]) -> Expr -> Expr+mapExprStatementExpr goE goS = runIdentity . mapExprStatementExprM (return . goE) (return . goS)+ mapSubExprM :: Monad m => (Expr -> m Expr) -> Expr -> m Expr mapSubExprM f e = mapExprStatementExprM f (return . (: [])) e @@ -243,11 +237,11 @@   LeftGet i e -> LeftGet i <$> mapDirectExprLeftExprM f e  replaceExpr :: VarName -> Expr -> Expr -> Expr-replaceExpr x e = runIdentity . mapExprStatementExprM go (return . (: []))+replaceExpr x e = mapExprStatementExpr go (: [])   where     go = \case-      Var y | y == x -> return e-      e' -> return e'+      Var y | y == x -> e+      e' -> e'  replaceStatement :: VarName -> Expr -> Statement -> Statement replaceStatement x e = head . runIdentity . mapExprStatementStatementM go (return . (: []))@@ -255,3 +249,53 @@     go = \case       Var y | y == x -> return e       e' -> return e'++mapToplevelStatementProgramM :: Monad m => (ToplevelStatement -> m [ToplevelStatement]) -> Program -> m Program+mapToplevelStatementProgramM f prog = Program . concat <$> mapM f (decls prog)++mapLeftExprAssignExprM :: Applicative m => (LeftExpr -> m LeftExpr) -> AssignExpr -> m AssignExpr+mapLeftExprAssignExprM f = \case+  AssignExpr op e1 e2 -> AssignExpr op <$> f e1 <*> pure e2+  AssignIncr e -> AssignIncr <$> f e+  AssignDecr e -> AssignDecr <$> f e++mapLeftExprAssignExpr :: (LeftExpr -> LeftExpr) -> AssignExpr -> AssignExpr+mapLeftExprAssignExpr f = runIdentity . mapLeftExprAssignExprM (return . f)++mapVarNameExprStatementGenericM :: forall m a. Monad m => ((Expr -> m Expr) -> (Statement -> m [Statement]) -> a) -> (VarName -> m VarName) -> a+mapVarNameExprStatementGenericM mapExprStatementM f = mapExprStatementM goE (fmap (: []) . goS)+  where+    goE = \case+      Var x -> Var <$> f x+      Lam args ret body -> Lam <$> mapM (\(t, x) -> (t,) <$> f x) args <*> pure ret <*> pure body+      e -> return e+    goS :: Statement -> m Statement+    goS = \case+      Assign e -> Assign <$> goAssignExpr e+      Declare t x init -> Declare t <$> f x <*> pure init+      DeclareDestructure xs e -> DeclareDestructure <$> mapM f xs <*> pure e+      For t x init pred incr body -> For t <$> f x <*> pure init <*> pure pred <*> goAssignExpr incr <*> pure body+      ForEach t x e body -> ForEach t <$> f x <*> pure e <*> pure body+      stmt -> return stmt+    goAssignExpr = mapLeftExprAssignExprM goLeftExpr+    goLeftExpr = \case+      LeftVar x -> LeftVar <$> f x+      LeftAt e1 e2 -> LeftAt <$> goLeftExpr e1 <*> pure e2+      LeftGet n e -> LeftGet n <$> goLeftExpr e++mapVarNameStatementM :: Monad m => (VarName -> m VarName) -> Statement -> m Statement+mapVarNameStatementM f stmt = head <$> mapVarNameExprStatementGenericM mapExprStatementStatementM f stmt++mapVarNameToplevelStatementM :: Monad m => (VarName -> m VarName) -> ToplevelStatement -> m ToplevelStatement+mapVarNameToplevelStatementM f stmt = do+  stmt <- case stmt of+    VarDef t x e -> VarDef t <$> f x <*> pure e+    FunDef ret g args body -> FunDef ret g <$> mapM (\(t, x) -> (t,) <$> f x) args <*> pure body+    _ -> return stmt+  mapVarNameExprStatementGenericM mapExprStatementToplevelStatementM f stmt++mapVarNameProgramM :: Monad m => (VarName -> m VarName) -> Program -> m Program+mapVarNameProgramM f = mapToplevelStatementProgramM (fmap (: []) . mapVarNameToplevelStatementM f)++renameVarNameStatement :: VarName -> VarName -> Statement -> Statement+renameVarNameStatement x y = runIdentity . mapVarNameStatementM (\z -> return $ if z == x then y else z)

@@ -34,8 +34,8 @@     let ReadWriteList rs ws = analyzeStatements body         args' = S.fromList (map snd args)      in ReadWriteList (rs `S.difference` args') (ws `S.difference` args')-  Call _ args -> mconcat (map analyzeExpr args)-  CallExpr f args -> mconcat (map analyzeExpr (f : args))+  Call f args -> mconcat (map analyzeExpr (f : args))+  Callable _ -> mempty  analyzeLeftExpr :: LeftExpr -> ReadWriteList analyzeLeftExpr = \case

@@ -0,0 +1,39 @@+{-# LANGUAGE LambdaCase #-}++module Jikka.Common.Name where++import Data.List+import Data.Maybe+import Text.Read++type OccName = Maybe String++type NameFlavour = Maybe Int++toFlavouredName :: String -> (OccName, NameFlavour)+toFlavouredName = \case+  "_" -> (Nothing, Nothing)+  s -> case elemIndex '$' s of+    Nothing -> (Just s, Nothing)+    Just i ->+      let (occ, flavour) = splitAt i s+          occ' = if occ == "" then Nothing else Just occ+          flavour' = case readMaybe (tail flavour) of+            Nothing -> error $ "Jikka.Common.Name.toFlavouredName: invalid flavoured name: " ++ s+            Just i -> i+       in (occ', Just flavour')++formatFlavouredName :: OccName -> NameFlavour -> String+formatFlavouredName occ flavour = case (occ, flavour) of+  (Nothing, Nothing) -> "_"+  _ -> fromMaybe "" occ ++ maybe "" (('$' :) . show) flavour++data NameHint+  = LocalNameHint+  | LocalArgumentNameHint+  | LoopCounterNameHint+  | ConstantNameHint+  | FunctionNameHint+  | ArgumentNameHint+  | AdHocNameHint String+  deriving (Eq, Ord, Show, Read)

@@ -35,16 +35,15 @@     if x `notElem` used       then return x       else do-        let base = takeWhile (/= '$') (unVarName x)-        i <- nextCounter-        return $ VarName (base ++ "$" ++ show i)+        let base = takeWhile (/= '$') (formatVarName x)+        VarName (Just base) . Just <$> nextCounter   put $ y : used   return y  runExpr' :: (MonadState UsedVars m, MonadAlpha m, MonadError Error m) => RenameMapping -> Expr -> m Expr runExpr' env = \case   Var x -> case lookup x env of-    Nothing -> throwInternalError $ "undefined variable: " ++ unVarName x+    Nothing -> throwInternalError $ "undefined variable: " ++ formatVarName x     Just y -> return $ Var y   Lit lit -> return $ Lit lit   App f e -> App <$> runExpr' env f <*> runExpr' env e

@@ -17,39 +17,26 @@   ) where -import Data.Maybe import Jikka.Common.Alpha import Jikka.Common.Error import Jikka.Core.Language.BuiltinPatterns+import Jikka.Core.Language.Eta import Jikka.Core.Language.Expr import Jikka.Core.Language.Lint import Jikka.Core.Language.RewriteRules-import Jikka.Core.Language.Util -expandExpr :: MonadAlpha m => Type -> Expr -> m (Maybe Expr)-expandExpr t e = case (t, e) of-  (FunTy t1 t2, Lam x _ body) -> do-    body <- expandExpr t2 body-    return $ Lam x t1 <$> body-  (FunTy t1 t2, e) -> do-    x <- genVarName'-    let e' = App e (Var x)-    e'' <- expandExpr t2 e'-    return . Just $ Lam x t1 (fromMaybe e' e'')-  _ -> return Nothing--rule :: MonadAlpha m => RewriteRule m+rule :: (MonadAlpha m, MonadError Error m) => RewriteRule m rule =-  let go :: MonadAlpha m => Expr -> Type -> (Expr -> Expr) -> m (Maybe Expr)-      go e t f = (f <$>) <$> expandExpr t e-   in makeRewriteRule "eta-reduction" $ \_ -> \case-        Let x t e1 e2 -> go e1 t (\e1 -> Let x t e1 e2)-        Iterate' t k f x -> go f (FunTy t t) (\f -> Iterate' t k f x)-        Foldl' t1 t2 f init xs -> go f (FunTy t2 (FunTy t1 t1)) (\f -> Foldl' t1 t2 f init xs)-        Scanl' t1 t2 f init xs -> go f (FunTy t2 (FunTy t1 t1)) (\f -> Scanl' t1 t2 f init xs)-        Build' t f xs n -> go f (FunTy (ListTy t) t) (\f -> Build' t f xs n)-        Map' t1 t2 f xs -> go f (FunTy t1 t2) (\f -> Map' t1 t2 f xs)-        Filter' t f xs -> go f (FunTy t BoolTy) (\f -> Filter' t f xs)+  let go :: (MonadAlpha m, MonadError Error m) => RewriteEnvironment -> Expr -> (Expr -> Expr) -> m (Maybe Expr)+      go env e f = (f <$>) <$> etaExpand' (typeEnv env) e+   in makeRewriteRule "eta-expansion" $ \env -> \case+        Let x t e1 e2 -> go env e1 (\e1 -> Let x t e1 e2)+        Iterate' t k f x -> go env f (\f -> Iterate' t k f x)+        Foldl' t1 t2 f init xs -> go env f (\f -> Foldl' t1 t2 f init xs)+        Scanl' t1 t2 f init xs -> go env f (\f -> Scanl' t1 t2 f init xs)+        Build' t f xs n -> go env f (\f -> Build' t f xs n)+        Map' t1 t2 f xs -> go env f (\f -> Map' t1 t2 f xs)+        Filter' t f xs -> go env f (\f -> Filter' t f xs)         _ -> return Nothing  runProgram :: (MonadAlpha m, MonadError Error m) => Program -> m Program

@@ -52,8 +52,8 @@     )   where     CumulativeSum t f e es =-      let x1 = findUnusedVarName (VarName "y") f-          x2 = findUnusedVarName (VarName "x") f+      let x1 = findUnusedVarName' f+          x2 = findUnusedVarName' f        in Scanl' t t (Lam2 x1 t x2 t (App (App f (Var x1)) (Var x2))) e es  pattern CumulativeSumFlip t f e es <-@@ -65,8 +65,8 @@     )   where     CumulativeSumFlip t f e es =-      let x1 = findUnusedVarName (VarName "y") f-          x2 = findUnusedVarName (VarName "x") f+      let x1 = findUnusedVarName' f+          x2 = findUnusedVarName' f        in Scanl' t t (Lam2 x1 t x2 t (App (App f (Var x2)) (Var x1))) e es  builtinToSemigroup :: Builtin -> [Type] -> Maybe Semigroup'

@@ -66,7 +66,7 @@  wrapErrorFromHint :: MonadError Error m => Hint -> m a -> m a wrapErrorFromHint = \case-  VarHint x -> wrapError' $ "around variable " ++ unVarName x+  VarHint x -> wrapError' $ "around variable " ++ formatVarName x   ExprHint e -> wrapError' $ "around expr " ++ summarize (formatExpr e)   ToplevelExprHint e -> wrapError' $ "around toplevel expr " ++ summarize (formatToplevelExpr e)   where@@ -170,7 +170,7 @@ unifyTyVar :: (MonadState Subst m, MonadError Error m) => TypeName -> Type -> m () unifyTyVar x t =   if x `elem` freeTyVars t-    then throwInternalError $ "looped type equation " ++ unTypeName x ++ " = " ++ formatType t+    then throwInternalError $ "looped type equation " ++ formatTypeName x ++ " = " ++ formatType t     else do       modify' (Subst . M.insert x t . unSubst) -- This doesn't introduce the loop. 

@@ -259,10 +259,10 @@     SegmentTreeSetPoint _ -> go3' valueToList valueToInt pure ValList setAtEither  callLambda :: MonadError Error m => Maybe VarName -> Env -> VarName -> Type -> Expr -> [Value] -> m Value-callLambda = \name env x t body args -> wrapError' ("while calling lambda " ++ maybe "(anonymous)" unVarName name) $ go Nothing env x t body args+callLambda = \name env x t body args -> wrapError' ("while calling lambda " ++ maybe "(anonymous)" formatVarName name) $ go Nothing env x t body args   where     go name env x t body [] = return $ ValLambda name env x t body-    go name env x _ body (e : args) = maybe id (\name -> wrapError' $ "while calling lambda " ++ unVarName name) name $ do+    go name env x _ body (e : args) = maybe id (\name -> wrapError' $ "while calling lambda " ++ formatVarName name) name $ do       body <- evaluateExpr ((x, e) : env) body       case body of         ValLambda name env x t body -> go name env x t body args@@ -278,7 +278,7 @@ evaluateExpr :: MonadError Error m => Env -> Expr -> m Value evaluateExpr env = \case   Var x -> case lookup x env of-    Nothing -> throwInternalError $ "undefined variable: " ++ unVarName x+    Nothing -> throwInternalError $ "undefined variable: " ++ formatVarName x     Just val -> return val   Lit lit -> case lit of     LitBuiltin ConvexHullTrickInit ts -> callBuiltin ConvexHullTrickInit ts []

@@ -109,7 +109,7 @@  formatType' :: Type -> (String, Prec) formatType' = \case-  VarTy (TypeName a) -> (a, identPrec)+  VarTy a -> (formatTypeName a, identPrec)   IntTy -> ("int", identPrec)   BoolTy -> ("bool", identPrec)   ListTy t -> (resolvePrec funCallPrec (formatType' t) ++ " list", funCallPrec)@@ -306,16 +306,16 @@   LitBottom _ msg -> "bottom<" ++ show msg ++ ">"  formatFormalArgs :: [(VarName, Type)] -> String-formatFormalArgs args = unwords $ map (\(x, t) -> paren (unVarName x ++ ": " ++ formatType t)) args+formatFormalArgs args = unwords $ map (\(x, t) -> paren (formatVarName x ++ ": " ++ formatType t)) args  formatExpr' :: Expr -> (String, Prec) formatExpr' = \case-  Var x -> (unVarName x, identPrec)+  Var x -> (formatVarName x, identPrec)   Lit lit -> (formatLiteral lit, identPrec)   e@(App _ _) ->     let (f, args) = curryApp e      in case f of-          Var x -> formatFunCall (unVarName x, identPrec) args+          Var x -> formatFunCall (formatVarName x, identPrec) args           Lit (LitBuiltin builtin ts) -> formatBuiltin' builtin ts args           _ -> formatFunCall (formatExpr' f) args   LamId _ -> ("id", identPrec)@@ -323,7 +323,7 @@   e@(Lam _ _ _) ->     let (args, body) = uncurryLam e      in ("fun " ++ formatFormalArgs args ++ " ->\n" ++ indent ++ "\n" ++ resolvePrec parenPrec (formatExpr' body) ++ "\n" ++ dedent ++ "\n", lambdaPrec)-  Let x t e1 e2 -> ("let " ++ unVarName x ++ ": " ++ formatType t ++ " = " ++ resolvePrec parenPrec (formatExpr' e1) ++ "\nin " ++ resolvePrec lambdaPrec (formatExpr' e2), lambdaPrec)+  Let x t e1 e2 -> ("let " ++ formatVarName x ++ ": " ++ formatType t ++ " = " ++ resolvePrec parenPrec (formatExpr' e1) ++ "\nin " ++ resolvePrec lambdaPrec (formatExpr' e2), lambdaPrec)   Assert e1 e2 -> ("assert " ++ resolvePrec parenPrec (formatExpr' e1) ++ " in\n" ++ resolvePrec lambdaPrec (formatExpr' e2), lambdaPrec)  formatExpr :: Expr -> String@@ -332,8 +332,8 @@ formatToplevelExpr' :: ToplevelExpr -> [String] formatToplevelExpr' = \case   ResultExpr e -> lines (resolvePrec lambdaPrec (formatExpr' e))-  ToplevelLet x t e cont -> let' (unVarName x) t e cont-  ToplevelLetRec f args ret e cont -> let' ("rec " ++ unVarName f ++ " " ++ formatFormalArgs args) ret e cont+  ToplevelLet x t e cont -> let' (formatVarName x) t e cont+  ToplevelLetRec f args ret e cont -> let' ("rec " ++ formatVarName f ++ " " ++ formatFormalArgs args) ret e cont   ToplevelAssert e cont -> ["assert " ++ resolvePrec parenPrec (formatExpr' e), "in"] ++ formatToplevelExpr' cont   where     let' s t e cont =

@@ -57,14 +57,14 @@       then return $ ToplevelLet y t e' cont       else do         when (y `isFreeVar` e) $ do-          throwInternalError $ "Jikka.Core.Language.Beta.substituteToplevelExpr: toplevel name conflicts: " ++ unVarName y+          throwInternalError $ "Jikka.Core.Language.Beta.substituteToplevelExpr: toplevel name conflicts: " ++ formatVarName y         ToplevelLet y t e' <$> substituteToplevelExpr x e cont   ToplevelLetRec f args ret body cont -> do     if f == x       then return $ ToplevelLetRec f args ret body cont       else do         when (f `isFreeVar` e) $ do-          throwInternalError $ "Jikka.Core.Language.Beta.substituteToplevelExpr: toplevel name conflicts: " ++ unVarName f+          throwInternalError $ "Jikka.Core.Language.Beta.substituteToplevelExpr: toplevel name conflicts: " ++ formatVarName f         (args, body) <-           if x `elem` map fst args             then return (args, body)

@@ -0,0 +1,95 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module      : Jikka.Core.Language.Eta+-- Description : does eta-reductions and eta-expansions. / eta 簡約および eta 展開を行います。+-- Copyright   : (c) Kimiyuki Onaka, 2021+-- License     : Apache License 2.0+-- Maintainer  : kimiyuki95@gmail.com+-- Stability   : experimental+-- Portability : portable+module Jikka.Core.Language.Eta+  ( etaExpand,+    etaExpand',+    etaReduce,+    etaReduce',+  )+where++import Control.Monad.Trans.Maybe+import Data.Maybe+import Jikka.Common.Alpha+import Jikka.Common.Error+import Jikka.Core.Language.Expr+import Jikka.Core.Language.FreeVars+import Jikka.Core.Language.TypeCheck+import Jikka.Core.Language.Util++etaExpand' :: (MonadAlpha m, MonadError Error m) => [(VarName, Type)] -> Expr -> m (Maybe Expr)+etaExpand' env e = runMaybeT $ do+  t <- lift $ typecheckExpr env e+  ts <- case uncurryFunTy t of+    (ts@(_ : _), _) -> return ts+    _ -> hoistMaybe Nothing+  let (args, body) = uncurryLam e+  guard $ length args /= length ts -- otherwise, it's already eta-expanded+  args' <- forM (drop (length args) ts) $ \t -> do+    x <- lift genVarName'+    return (x, t)+  return $ curryLam (args ++ args') (uncurryApp body (map (Var . fst) args'))++-- `etaExpand` does an eta-expansion.+--+-- == Examples+--+-- Before:+--+-- > map+--+-- After:+--+-- > fun f xs -> map f xs+--+-- Before:+--+-- > let f x y = x + y in f+--+-- After:+--+-- > fun x y -> (let f x y = x + y in f) x y+etaExpand :: (MonadAlpha m, MonadError Error m) => [(VarName, Type)] -> Expr -> m Expr+etaExpand env e = fromMaybe e <$> etaExpand' env e++etaReduce' :: Expr -> Maybe Expr+etaReduce' e = do+  let (args, body) = uncurryLam e+  let (f, args') = curryApp body+  guard $ length args <= length args'+  let k = length args' - length args+  let f' = uncurryApp f (take k args')+  let args'' = drop k args'+  guard $ args'' == map (Var . fst) args+  guard $ all (\(x, _) -> x `isUnusedVar` f') args+  return f'++-- `etaReduce` does an eta-reduce in the result expr.+--+-- == Examples+--+-- Before:+--+-- > fun f xs -> map f xs+--+-- After:+--+-- > map+--+-- Before:+--+-- > fun x y -> (let f x y = x + y in f) x y+--+-- After:+--+-- > let f x y = x + y in f+etaReduce :: Expr -> Expr+etaReduce e = fromMaybe e (etaReduce' e)

@@ -1,5 +1,4 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}@@ -18,17 +17,25 @@ module Jikka.Core.Language.Expr where  import Data.Data-import Data.String (IsString)+import Data.String+import Jikka.Common.Name -newtype VarName = VarName String deriving (Eq, Ord, Show, Read, Data, Typeable, IsString)+-- NOTE: @VarName occ flavour == VarName occ' flavour'@ is defined as @occ == occ' && flavour == flavour'@ but we assume that this is equivalent to @flavour == flavour'@ unless they are @Nothing@.+data VarName = VarName OccName NameFlavour deriving (Eq, Ord, Show, Read, Data, Typeable) -unVarName :: VarName -> String-unVarName (VarName name) = name+instance IsString VarName where+  fromString = uncurry VarName . toFlavouredName -newtype TypeName = TypeName String deriving (Eq, Ord, Show, Read, Data, Typeable, IsString)+formatVarName :: VarName -> String+formatVarName (VarName occ flavour) = formatFlavouredName occ flavour -unTypeName :: TypeName -> String-unTypeName (TypeName name) = name+data TypeName = TypeName OccName NameFlavour deriving (Eq, Ord, Show, Read, Data, Typeable)++instance IsString TypeName where+  fromString = uncurry TypeName . toFlavouredName++formatTypeName :: TypeName -> String+formatTypeName (TypeName occ flavour) = formatFlavouredName occ flavour  -- | `Type` represents the types of our core language. This is similar to the `Type` of GHC Core. -- See also [commentary/compiler/type-type](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/type-type).

@@ -10,8 +10,19 @@ -- Portability : portable module Jikka.Core.Language.FreeVars where +import Data.Maybe+import qualified Data.Set as S import Jikka.Core.Language.Expr +freeVars :: Expr -> S.Set VarName+freeVars = \case+  Var x -> S.singleton x+  Lit _ -> S.empty+  App f e -> freeVars f <> freeVars e+  Lam x _ e -> S.delete x (freeVars e)+  Let x _ e1 e2 -> freeVars e1 <> S.delete x (freeVars e2)+  Assert e1 e2 -> freeVars e1 <> freeVars e2+ -- | `isFreeVar` checks if the given variable occurs in the tiven expr. This considers contexts. -- -- >>> VarName "x" `isFreeVar` Lam (VarName "y") IntTy (Var (VarName "x"))@@ -58,7 +69,10 @@   DataStructureTy _ -> []  findUnusedVarName :: VarName -> Expr -> VarName-findUnusedVarName (VarName x) e = head . filter (`isUnusedVar` e) $ map (\i -> VarName (x ++ show i)) [0 ..]+findUnusedVarName (VarName x _) e =+  let xs = S.fromList (concatMap (\(VarName _ i) -> maybeToList i) (S.toList (freeVars e)))+      flavour = head $ filter (`S.notMember` xs) [0 ..]+   in VarName x (Just flavour)  findUnusedVarName' :: Expr -> VarName-findUnusedVarName' = findUnusedVarName (VarName "x")+findUnusedVarName' = findUnusedVarName (VarName Nothing Nothing)

@@ -26,7 +26,7 @@ define x t = do   env <- get   case lookup x env of-    Just t' -> throwInternalError $ "name conflict: " ++ unVarName x ++ ": " ++ formatType t ++ " and " ++ unVarName x ++ ": " ++ formatType t'+    Just t' -> throwInternalError $ "name conflict: " ++ formatVarName x ++ ": " ++ formatType t ++ " and " ++ formatVarName x ++ ": " ++ formatType t'     Nothing -> put $ (x, t) : env  namecheckExpr' :: (MonadState [(VarName, Type)] m, MonadError Error m) => Expr -> m ()@@ -34,7 +34,7 @@   Var x -> do     env <- get     case lookup x env of-      Nothing -> throwInternalError $ "undefined variable: " ++ unVarName x+      Nothing -> throwInternalError $ "undefined variable: " ++ formatVarName x       Just _ -> return ()   Lit _ -> return ()   App f e -> do

@@ -18,6 +18,7 @@ import Control.Arrow import Control.Monad.State.Strict import Data.Data+import Data.Maybe import Jikka.Common.Alpha import Jikka.Common.Error import Jikka.Common.Format.Error@@ -40,14 +41,12 @@     Right y -> return y  fromVarName :: VarName -> Q TH.Name-fromVarName (VarName x) = do-  let base = takeWhile (/= '$') x-  TH.newName (if null base then "x" else base)+fromVarName (VarName x _) = do+  TH.newName (fromMaybe "x" x)  fromTypeName :: TypeName -> Q TH.Name-fromTypeName (TypeName x) = do-  let base = takeWhile (/= '$') x-  TH.newName (if null base then "t" else base)+fromTypeName (TypeName x _) = do+  TH.newName (fromMaybe "t" x)  liftDataP :: Data a => a -> Q Pat liftDataP = TH.dataToPatQ (const Nothing)@@ -121,7 +120,7 @@ toPatE :: Expr -> StateT Env Q Pat toPatE = \case   Var x ->-    if x == VarName "_"+    if x == VarName Nothing Nothing       then return WildP       else do         env <- gets vars@@ -132,7 +131,7 @@             y <- lift $ fromVarName x             modify' (\env -> env {vars = (x, RenamedVar (VarE y)) : vars env})             return $ VarP y-          Nothing -> fail $ "Jikka.Core.Language.QuasiRules.toPatE: undefined variable (forall is required): " ++ unVarName x+          Nothing -> fail $ "Jikka.Core.Language.QuasiRules.toPatE: undefined variable (forall is required): " ++ formatVarName x   Lit lit -> do     lit <- toPatL lit     lift [p|Lit $(pure lit)|]@@ -166,7 +165,7 @@     env <- gets typeVars     case lookup x env of       Just y -> return $ VarE y-      Nothing -> fail $ "Jikka.Core.Language.QuasiRules.toExpT: undefined type variable: " ++ unTypeName x+      Nothing -> fail $ "Jikka.Core.Language.QuasiRules.toExpT: undefined type variable: " ++ formatTypeName x   IntTy -> do     lift $ TH.liftData IntTy   BoolTy -> do@@ -207,7 +206,7 @@       env <- gets vars       case expFromRenamedVarName <$> lookup x env of         Just (Just y) -> return ([], y)-        _ -> fail $ "Jikka.Core.Language.QuasiRules.toExpE: undefined variable: " ++ unVarName x+        _ -> fail $ "Jikka.Core.Language.QuasiRules.toExpE: undefined variable: " ++ formatVarName x     Lit lit -> do       lit <- toExpL lit       e <- lift [e|Lit $(pure lit)|]@@ -233,7 +232,7 @@           (stmts, e) <- toExpE e           e <- lift [e|Lam $(pure (VarE y)) $(pure t) $(pure e)|]           return (BindS (VarP y) genVarName : stmts, e)-        _ -> fail $ "Jikka.Core.Language.QuasiRules.toExpE: variable conflicts: " ++ unVarName x+        _ -> fail $ "Jikka.Core.Language.QuasiRules.toExpE: variable conflicts: " ++ formatVarName x     Let x t e1 e2 -> do       t <- toExpT t       (stmts, e1) <- toExpE e1@@ -251,7 +250,7 @@           (stmts', e2) <- toExpE e2           e <- lift [e|Let $(pure (VarE y)) $(pure t) $(pure e1) $(pure e2)|]           return (stmts ++ BindS (VarP y) genVarName : stmts', e)-        _ -> fail $ "Jikka.Core.Language.QuasiRules.toExpE: variable conflicts: " ++ unVarName x+        _ -> fail $ "Jikka.Core.Language.QuasiRules.toExpE: variable conflicts: " ++ formatVarName x     Assert e1 e2 -> do       (stmts1, e1) <- toExpE e1       (stmts2, e2) <- toExpE e2

@@ -166,7 +166,7 @@ typecheckExpr :: MonadError Error m => TypeEnv -> Expr -> m Type typecheckExpr env = \case   Var x -> case lookup x env of-    Nothing -> throwInternalError $ "undefined variable: " ++ unVarName x+    Nothing -> throwInternalError $ "undefined variable: " ++ formatVarName x     Just t -> return t   Lit lit -> literalToType lit   App f e -> do@@ -176,13 +176,13 @@       FunTy te' ret | te' == te -> return ret       _ -> throwInternalError $ "wrong type funcall: function = " ++ formatExpr f ++ " and argument = " ++ formatExpr e ++ ", function's type = " ++ formatType tf ++ ", but argument's type = " ++ formatType te   Lam x t e ->-    let env' = if x == VarName "_" then env else (x, t) : env+    let env' = if x == VarName Nothing Nothing then env else (x, t) : env      in FunTy t <$> typecheckExpr env' e   Let x t e1 e2 -> do     t' <- typecheckExpr env e1     when (t /= t') $ do       throwInternalError $ "wrong type binding: " ++ formatExpr (Let x t e1 e2)-    let env' = if x == VarName "_" then env else (x, t) : env+    let env' = if x == VarName Nothing Nothing then env else (x, t) : env     typecheckExpr env' e2   Assert e1 e2 -> do     t <- typecheckExpr env e1@@ -196,13 +196,13 @@   ToplevelLet x t e cont -> do     t' <- typecheckExpr env e     when (t' /= t) $ do-      throwInternalError $ "assigned type is not correct: context = (let " ++ unVarName x ++ ": " ++ formatType t ++ " = " ++ formatExpr e ++ " in ...), expected type = " ++ formatType t ++ ", actual type = " ++ formatType t'+      throwInternalError $ "assigned type is not correct: context = (let " ++ formatVarName x ++ ": " ++ formatType t ++ " = " ++ formatExpr e ++ " in ...), expected type = " ++ formatType t ++ ", actual type = " ++ formatType t'     typecheckToplevelExpr ((x, t) : env) cont   ToplevelLetRec f args ret body cont -> do     let t = curryFunTy (map snd args) ret     ret' <- typecheckExpr (reverse args ++ (f, t) : env) body     when (ret' /= ret) $ do-      throwInternalError $ "returned type is not correct: context = (let rec " ++ unVarName f ++ " " ++ unwords (map (\(x, t) -> unVarName x ++ ": " ++ formatType t) args) ++ ": " ++ formatType ret ++ " = " ++ formatExpr body ++ " in ...), expected type = " ++ formatType ret ++ ", actual type = " ++ formatType ret'+      throwInternalError $ "returned type is not correct: context = (let rec " ++ formatVarName f ++ " " ++ unwords (map (\(x, t) -> formatVarName x ++ ": " ++ formatType t) args) ++ ": " ++ formatType ret ++ " = " ++ formatExpr body ++ " in ...), expected type = " ++ formatType ret ++ ", actual type = " ++ formatType ret'     typecheckToplevelExpr ((f, t) : env) cont   ToplevelAssert e1 e2 -> do     t <- typecheckExpr env e1

@@ -17,18 +17,13 @@ import Jikka.Core.Language.Expr  genType :: MonadAlpha m => m Type-genType = do-  i <- nextCounter-  return $ VarTy (TypeName ('$' : show i))+genType = VarTy . TypeName Nothing . Just <$> nextCounter  genVarName :: MonadAlpha m => VarName -> m VarName-genVarName x = do-  i <- nextCounter-  let base = if unVarName x == "_" then "" else takeWhile (/= '$') (unVarName x)-  return $ VarName (base ++ '$' : show i)+genVarName (VarName x _) = VarName x . Just <$> nextCounter  genVarName' :: MonadAlpha m => m VarName-genVarName' = genVarName (VarName "_")+genVarName' = genVarName (VarName Nothing Nothing)  genVarName'' :: MonadAlpha m => Expr -> m VarName genVarName'' = \case

@@ -22,6 +22,7 @@     , runRule     ) where +import Data.String (fromString) import Data.List (intercalate) import Jikka.Common.Alpha import Jikka.Common.Error@@ -232,7 +233,7 @@  -- Types atom_type :: { Type }-    : IDENT                            { let (L.Ident x) = value $1 in VarTy (TypeName x) }+    : IDENT                            { let (L.Ident x) = value $1 in VarTy (fromString x) }     | "int"                            { IntTy }     | "bool"                           { BoolTy }     | atom_type "list"                 { ListTy $1 }@@ -276,8 +277,8 @@     | builtin                          { Lit (uncurry LitBuiltin $1) }  identifier :: { VarName }-    : IDENT                            { let (L.Ident x) = value $1 in VarName x }-    | "_"                              { VarName "_" }+    : IDENT                            { let (L.Ident x) = value $1 in fromString x }+    | "_"                              { VarName Nothing Nothing }  integer :: { Integer }     : INTEGER                          { let (L.Int n) = value $1 in n }@@ -528,7 +529,7 @@ (<@>) = (<$>)  underscoreTy :: Type-underscoreTy = VarTy (TypeName "_")+underscoreTy = VarTy (TypeName Nothing Nothing)  makeTuple :: MonadError Error m => [Expr] -> Type -> m Expr makeTuple es t = case t of@@ -544,13 +545,13 @@ replaceUnderscoresT :: MonadAlpha m => Type -> m Type replaceUnderscoresT = mapSubTypesM go where   go = \case-    VarTy (TypeName "_") -> genType+    VarTy (TypeName Nothing Nothing) -> genType     t -> return t  replaceUnderscoresE :: (MonadAlpha m, MonadError Error m) => [(VarName, Type)] -> Expr -> m Expr replaceUnderscoresE env = mapSubExprM go env where   go _ = \case-    Var (VarName "_") -> Var <$> genVarName'+    Var (VarName Nothing Nothing) -> Var <$> genVarName'     e@(Proj' [] i (Var x)) -> case lookup x env of       Just (TupleTy ts) -> return $ Proj' ts i (Var x) -- Fix types of projections if it's easily possible.       _ -> return e -- Some cases are impossible. You need to use Jikka.Core.Convert.TypeInfer.

@@ -11,10 +11,10 @@ module Jikka.Main where  import Data.Maybe (fromMaybe)-import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Version (showVersion) import qualified Jikka.CPlusPlus.Convert.BundleRuntime as BundleRuntime+import qualified Jikka.CPlusPlus.Convert.EmbedOriginalCode as EmbedOriginalCode import Jikka.Common.Error import Jikka.Common.Format.Error (hPrintError, hPrintErrorWithText) import qualified Jikka.Main.Subcommand.Convert as Convert@@ -134,9 +134,7 @@     output <-       return $         if target' == CPlusPlusTarget && embedOriginalCode opts-          then-            let headers = ["// This C++ code is transpiled using Jikka transpiler v" <> T.pack (showVersion version) <> " https://github.com/kmyk/Jikka", "// The original Python code:"]-             in T.unlines (headers ++ map ("//     " <>) (T.lines input)) <> output+          then EmbedOriginalCode.run input output           else output     liftIO $ T.putStr output   "debug" -> Debug.run path -- TODO: make this subcommand convenient

@@ -13,6 +13,7 @@  import Data.Text (Text, pack) import qualified Jikka.CPlusPlus.Convert as FromCore+import qualified Jikka.CPlusPlus.Convert.BurnFlavouredNames as BurnFlavouredNamesCPlusPlus import qualified Jikka.CPlusPlus.Format as FormatCPlusPlus import qualified Jikka.CPlusPlus.Language.Expr as CPlusPlus import Jikka.Common.Alpha@@ -72,7 +73,9 @@   PythonProgram prog -> return . pack $ show prog -- TODO   RestrictedPythonProgram prog -> FormatRestrictedPython.run prog   CoreProgram prog -> FormatCore.run prog-  CPlusPlusProgram prog -> FormatCPlusPlus.run prog+  CPlusPlusProgram prog -> do+    prog <- BurnFlavouredNamesCPlusPlus.run prog+    FormatCPlusPlus.run prog  run :: Target -> Target -> FilePath -> Text -> Either Error Text run source target path input = flip evalAlphaT 0 $ do

@@ -26,7 +26,9 @@ -- convert AST  runIdent :: X.Ident' -> Y.VarName'-runIdent (WithLoc loc (X.Ident x)) = WithLoc' (Just loc) (Y.VarName x)+runIdent (WithLoc loc (X.Ident x)) =+  let occ = if x == "_" then Nothing else Just x+   in WithLoc' (Just loc) (Y.VarName occ Nothing Nothing)  runAttribute :: X.Ident' -> Y.Attribute' runAttribute (WithLoc loc (X.Ident x)) = WithLoc' (Just loc) (Y.UnresolvedAttribute (Y.AttributeName x))

@@ -69,7 +69,7 @@     Just y -> return y     Nothing -> do       y <- genVarName x-      when (unVarName (value' x) /= "_") $ do+      when (value' x /= underscoreVarName) $ do         put $           env             { currentMapping = (value' x, value' y) : currentMapping env@@ -92,7 +92,7 @@ renameLocalCompletelyNew x = do   env <- get   case lookupLocalName x env of-    Just _ -> throwSemanticErrorAt' (loc' x) $ "cannot redefine variable: " ++ unVarName (value' x)+    Just _ -> throwSemanticErrorAt' (loc' x) $ "cannot redefine variable: " ++ formatVarName (value' x)     Nothing -> renameLocalNew x  -- | `renameToplevel` records given variables to the `Env` without actual renaming.@@ -103,11 +103,11 @@     Just _ -> do       let msg =             if value' x `S.member` builtinNames-              then "cannot assign to builtin function: " ++ unVarName (value' x)-              else "cannot redefine variable in toplevel: " ++ unVarName (value' x)+              then "cannot assign to builtin function: " ++ formatVarName (value' x)+              else "cannot redefine variable in toplevel: " ++ formatVarName (value' x)       throwSemanticErrorAt' (loc' x) msg     Nothing -> do-      when (unVarName (value' x) /= "_") $ do+      when (formatVarName (value' x) /= "_") $ do         put $           env             { currentMapping = (value' x, value' x) : currentMapping env@@ -120,7 +120,7 @@  popRename :: (MonadState Env m, MonadError Error m) => VarName' -> m () popRename x =-  when (unVarName (value' x) /= "_") $ do+  when (formatVarName (value' x) /= "_") $ do     y <- lookupName' x     modify' $ \env -> env {currentMapping = delete (value' x, value' y) (currentMapping env)} @@ -142,7 +142,7 @@   env <- get   case lookupName x env of     Just y -> return y-    Nothing -> throwSymbolErrorAt' (loc' x) $ "undefined identifier: " ++ unVarName (value' x)+    Nothing -> throwSymbolErrorAt' (loc' x) $ "undefined identifier: " ++ formatVarName (value' x)  -- | `runAnnTarget` renames targets of annotated assignments. runAnnTarget :: (MonadState Env m, MonadAlpha m, MonadError Error m) => Target' -> m Target'

@@ -28,18 +28,18 @@   [] -> throwSymbolError "solve function is not defined"   ToplevelAnnAssign _ _ _ : stmts -> lookupSolve stmts   ToplevelFunctionDef f args ret body : stmts -> case value' f of-    VarName "solve" -> return (loc' f, args, ret, body)+    VarName (Just "solve") Nothing Nothing -> return (loc' f, args, ret, body)     _ -> lookupSolve stmts   ToplevelAssert _ : stmts -> lookupSolve stmts  makeInputFormatFromType :: (MonadAlpha m, MonadError Error m) => Type -> m (FormatTree, String) makeInputFormatFromType = \case   IntTy -> do-    x <- unVarName . value' <$> genVarName'+    x <- formatVarName . value' <$> genVarName'     return (Exp (Var x), x)   ListTy t -> do-    n <- unVarName . value' <$> genVarName'-    i <- unVarName . value' <$> genVarName'+    n <- formatVarName . value' <$> genVarName'+    i <- formatVarName . value' <$> genVarName'     (body, x) <- makeInputFormatFromType t     body <- (`mapFormatTreeM` body) $ \case       Exp e -> return $ Exp (At e i)@@ -50,10 +50,10 @@ makeOutputFormatFromType' :: (MonadAlpha m, MonadError Error m) => Type -> m (FormatTree, String) makeOutputFormatFromType' = \case   IntTy -> do-    x <- unVarName . value' <$> genVarName'+    x <- formatVarName . value' <$> genVarName'     return (Exp (Var x), x)   ListTy t -> do-    i <- unVarName . value' <$> genVarName'+    i <- formatVarName . value' <$> genVarName'     (body, x) <- makeOutputFormatFromType' t     body <- (`mapFormatTreeM` body) $ \case       Exp e -> return $ Exp (At e i)

@@ -29,7 +29,7 @@ splitMain :: Program -> (Maybe MainFunction, Program) splitMain = \case   [] -> (Nothing, [])-  ToplevelFunctionDef (WithLoc' loc (VarName "main")) args ret body : stmts -> (Just (loc, args, ret, body), stmts)+  ToplevelFunctionDef (WithLoc' loc (VarName (Just "main") Nothing Nothing)) args ret body : stmts -> (Just (loc, args, ret, body), stmts)   stmt : stmts -> second (stmt :) $ splitMain stmts  checkMainType :: MonadError Error m => MainFunction -> m ()@@ -78,21 +78,21 @@ parseAnnAssign :: (MonadAlpha m, MonadError Error m) => Target' -> Type -> Expr' -> [Statement] -> m (FormatTree, Maybe ([String], Either String [String]), [Statement]) parseAnnAssign x _ e cont = do   let subscriptTrg x = case value' x of-        NameTrg x -> return (unVarName (value' x), [])-        SubscriptTrg x (WithLoc' _ (Name i)) -> second (++ [unVarName (value' i)]) <$> subscriptTrg x+        NameTrg x -> return (formatVarName (value' x), [])+        SubscriptTrg x (WithLoc' _ (Name i)) -> second (++ [formatVarName (value' i)]) <$> subscriptTrg x         _ -> throwSemanticErrorAt' (loc' x) $ "name target or subscript target is expected, but got: " ++ formatTarget x   let subscriptTupleTrg x = case value' x of         TupleTrg xs -> mapM subscriptTrg xs         _ -> throwSemanticErrorAt' (loc' x) $ "tuple target is expected, but got: " ++ formatTarget x   let nameTrg x = case value' x of-        NameTrg x -> return $ unVarName (value' x)+        NameTrg x -> return $ formatVarName (value' x)         _ -> throwSemanticErrorAt' (loc' x) $ "name target is expected, but got: " ++ formatTarget x   let nameOrTupleTrg x = case value' x of-        NameTrg x -> return . Left $ unVarName (value' x)+        NameTrg x -> return . Left $ formatVarName (value' x)         TupleTrg xs -> Right <$> mapM nameTrg xs         _ -> throwSemanticErrorAt' (loc' x) $ "name target or tuple target is expected, but got: " ++ formatTarget x   let nameExpr e = case value' e of-        Name x -> return $ unVarName (value' x)+        Name x -> return $ formatVarName (value' x)         _ -> throwSemanticErrorAt' (loc' e) $ "variable is expected, but got: " ++ formatExpr e   case e of     -- int(input())@@ -107,8 +107,8 @@     ListMapIntInputSplit -> do       (x, indices) <- subscriptTrg x       case cont of-        Assert (WithLoc' _ (Compare (CallBuiltin (BuiltinLen _) [WithLoc' _ (Name x')]) (CmpOp' Eq' _) n)) : cont | unVarName (value' x') == x -> do-          i <- unVarName . value' <$> genVarName'+        Assert (WithLoc' _ (Compare (CallBuiltin (BuiltinLen _) [WithLoc' _ (Name x')]) (CmpOp' Eq' _) n)) : cont | formatVarName (value' x') == x -> do+          i <- formatVarName . value' <$> genVarName'           n <- nameExpr n           return (Seq [Loop i (Var n) (Exp (At (packSubscriptedVar x indices) i)), Newline], Nothing, cont)         _ -> throwSemanticErrorAt' (loc' e) "after `xs = list(map(int, input().split()))', we need to write `assert len(xs) == n`"@@ -122,7 +122,7 @@         For _ (CallBuiltin BuiltinRange1 [WithLoc' _ (Name n')]) _ : _ | value' n' == n -> return (Seq [], Nothing, cont) -- TODO: add more strict checks         _ -> throwSemanticErrorAt' (loc' e) "after some repetition of `xs = list(range(n))', we need to write `for i in range(n):`"     -- solve(...)-    WithLoc' _ (Call (WithLoc' _ (Name (WithLoc' _ (VarName "solve")))) args) -> do+    WithLoc' _ (Call (WithLoc' _ (Name (WithLoc' _ (VarName (Just "solve") Nothing Nothing)))) args) -> do       inputs <- mapM nameExpr args       output <- nameOrTupleTrg x       return (Seq [], Just (inputs, output), cont)@@ -144,20 +144,20 @@     _ -> throwSemanticErrorAt' (loc' n) $ "for loops in main function must use `range(x)', `range(x + k)', `range(x - k)', `range(len(xs))`: " ++ formatExpr n   n <- return $ case n of     Right (n, k) ->-      let n' = Var (unVarName (value' n))+      let n' = Var (formatVarName (value' n))        in if k == 0 then n' else Plus n' k-    Left xs -> Len (Var (unVarName (value' xs)))+    Left xs -> Len (Var (formatVarName (value' xs)))   (input, solve, output) <- go body   when (isJust solve) $ do     throwSemanticError "cannot call `solve(...)' in for loop"-  let x' = unVarName (value' x)+  let x' = formatVarName (value' x)   return (Loop x' n input, Loop x' n output)  parseExprStatement :: (MonadAlpha m, MonadError Error m) => Expr' -> m FormatTree parseExprStatement e = do   let subscriptExpr e = case value' e of-        Name x -> return (unVarName (value' x), [])-        Subscript e (WithLoc' _ (Name i)) -> second (++ [unVarName (value' i)]) <$> subscriptExpr e+        Name x -> return (formatVarName (value' x), [])+        Subscript e (WithLoc' _ (Name i)) -> second (++ [formatVarName (value' i)]) <$> subscriptExpr e         _ -> throwSemanticErrorAt' (loc' e) $ "subscripted variable is expected, but got: " ++ formatExpr e   let starredExpr e = do         (e, starred) <- return $ case value' e of@@ -169,7 +169,7 @@         | not starred = return $ packSubscriptedVar' x indices         | otherwise = do           let xs = packSubscriptedVar x indices-          i <- unVarName . value' <$> genVarName'+          i <- formatVarName . value' <$> genVarName'           return $ Loop i (Len xs) (packSubscriptedVar' x (indices ++ [i]))   case e of     CallBuiltin (BuiltinPrint _) args -> do

@@ -47,11 +47,11 @@   return x  runVarName :: X.VarName' -> Y.VarName-runVarName (X.WithLoc' _ (X.VarName x)) = Y.VarName x+runVarName (X.WithLoc' _ (X.VarName occ flavour _)) = Y.VarName occ flavour  runType :: MonadError Error m => X.Type -> m Y.Type runType = \case-  X.VarTy (X.TypeName x) -> return $ Y.VarTy (Y.TypeName x)+  X.VarTy (X.TypeName occ flavour) -> return $ Y.VarTy (Y.TypeName occ flavour)   X.IntTy -> return Y.IntTy   X.BoolTy -> return Y.BoolTy   X.ListTy t -> Y.ListTy <$> runType t@@ -60,14 +60,14 @@   X.StringTy -> throwSemanticError "cannot use `str' type out of main function"   X.SideEffectTy -> throwSemanticError "side-effect type must be used only as expr-statement" -- TODO: check in Jikka.RestrictedPython.Language.Lint -runConstant :: MonadError Error m => X.Constant -> m Y.Expr+runConstant :: (MonadAlpha m, MonadError Error m) => X.Constant -> m Y.Expr runConstant = \case   X.ConstNone -> return $ Y.Tuple' []   X.ConstInt n -> return $ Y.Lit (Y.LitInt n)   X.ConstBool p -> return $ Y.Lit (Y.LitBool p)   X.ConstBuiltin builtin -> runBuiltin builtin -runBuiltin :: MonadError Error m => X.Builtin -> m Y.Expr+runBuiltin :: (MonadAlpha m, MonadError Error m) => X.Builtin -> m Y.Expr runBuiltin builtin = do   let go0 builtin = do         return $ Y.Lit (Y.LitBuiltin builtin [])@@ -109,24 +109,24 @@       _ -> do         ts <- mapM runType ts         ret <- runType ret-        let var i = Y.VarName ("xs" ++ show i)-        let lam body = Y.Lam "go0" (Y.curryFunTy ts ret) (foldr (\(i, t) -> Y.Lam (var i) (Y.ListTy t)) body (zip [0 ..] ts))-        let len = Y.Min1' Y.IntTy (foldr (Y.Cons' Y.IntTy) (Y.Nil' Y.IntTy) (zipWith (\i t -> Y.Len' t (Y.Var (var i))) [0 ..] ts))-        let body = Y.Map' Y.IntTy ret (Y.Lam "i" Y.IntTy (Y.uncurryApp (Y.Var "go0") (map (Y.Var . var) [0 .. length ts - 1]))) (Y.Range1' len)+        xs <- replicateM (length ts) Y.genVarName'+        let lam body = Y.Lam "go0" (Y.curryFunTy ts ret) (foldr (\(i, t) -> Y.Lam (xs !! i) (Y.ListTy t)) body (zip [0 ..] ts))+        let len = Y.Min1' Y.IntTy (foldr (Y.Cons' Y.IntTy) (Y.Nil' Y.IntTy) (zipWith (\i t -> Y.Len' t (Y.Var (xs !! i))) [0 ..] ts))+        let body = Y.Map' Y.IntTy ret (Y.Lam "i" Y.IntTy (Y.uncurryApp (Y.Var "go0") (zipWith (\i t -> Y.At' t (Y.Var (xs !! i)) (Y.Var "i")) [0 ..] ts))) (Y.Range1' len)         return $ lam body     X.BuiltinSorted t -> go1 Y.Sorted t     X.BuiltinReversed t -> go1 Y.Reversed t     X.BuiltinEnumerate t -> do       t <- runType t       let body = Y.Lam "i" Y.IntTy (Y.uncurryApp (Y.Tuple' [Y.IntTy, t]) [Y.Var "i", Y.At' t (Y.Var "xs") (Y.Var "i")])-      return $ Y.Lam "xs" (Y.ListTy t) (Y.Map' (Y.ListTy t) (Y.ListTy (Y.TupleTy [Y.IntTy, t])) body (Y.Range1' (Y.Len' t (Y.Var "xs"))))+      return $ Y.Lam "xs" (Y.ListTy t) (Y.Map' Y.IntTy (Y.TupleTy [Y.IntTy, t]) body (Y.Range1' (Y.Len' t (Y.Var "xs"))))     X.BuiltinFilter t -> go1 Y.Filter t     X.BuiltinZip ts -> do       ts <- mapM runType ts-      let var i = Y.VarName ("xs" ++ show i)-      let lam body = foldr (\(i, t) -> Y.Lam (var i) (Y.ListTy t)) body (zip [0 ..] ts)-      let len = Y.Min1' Y.IntTy (foldr (Y.Cons' Y.IntTy) (Y.Nil' Y.IntTy) (zipWith (\i t -> Y.Len' t (Y.Var (var i))) [0 ..] ts))-      let body = Y.Map' Y.IntTy (Y.TupleTy ts) (Y.Lam "i" Y.IntTy (Y.uncurryApp (Y.Tuple' ts) (map (Y.Var . var) [0 .. length ts - 1]))) (Y.Range1' len)+      xs <- replicateM (length ts) Y.genVarName'+      let lam body = foldr (\(i, t) -> Y.Lam (xs !! i) (Y.ListTy t)) body (zip [0 ..] ts)+      let len = Y.Min1' Y.IntTy (foldr (Y.Cons' Y.IntTy) (Y.Nil' Y.IntTy) (zipWith (\i t -> Y.Len' t (Y.Var (xs !! i))) [0 ..] ts))+      let body = Y.Map' Y.IntTy (Y.TupleTy ts) (Y.Lam "i" Y.IntTy (Y.uncurryApp (Y.Tuple' ts) (zipWith (\i t -> Y.At' t (Y.Var (xs !! i)) (Y.Var "i")) [0 ..] ts))) (Y.Range1' len)       return $ lam body     X.BuiltinAll -> go0 Y.All     X.BuiltinAny -> go0 Y.Any@@ -140,14 +140,14 @@       when (n < 2) $ do         throwTypeError $ "max expected 2 or more arguments, got " ++ show n       t <- runType t-      let args = map (\i -> Y.VarName ('x' : show i)) [0 .. n -1]+      args <- replicateM n Y.genVarName'       return $ Y.curryLam (map (,t) args) (foldr1 (Y.Max2' t) (map Y.Var args))     X.BuiltinMin1 t -> go1 Y.Min1 t     X.BuiltinMin t n -> do       when (n < 2) $ do         throwTypeError $ "max min 2 or more arguments, got " ++ show n       t <- runType t-      let args = map (\i -> Y.VarName ('x' : show i)) [0 .. n -1]+      args <- replicateM n Y.genVarName'       return $ Y.curryLam (map (,t) args) (foldr1 (Y.Min2' t) (map Y.Var args))     X.BuiltinArgMax t -> go1 Y.ArgMax t     X.BuiltinArgMin t -> go1 Y.ArgMin t

@@ -45,7 +45,7 @@   local <- get   case M.lookup (value' x) (unLocal local) of     Just v -> return v-    Nothing -> throwInternalErrorAt' (loc' x) $ "undefined variable: " ++ unVarName (value' x)+    Nothing -> throwInternalErrorAt' (loc' x) $ "undefined variable: " ++ formatVarName (value' x)  assignSubscriptedTarget :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Target' -> Expr' -> Value -> m () assignSubscriptedTarget f index v = wrapAt' (loc' f) $ do@@ -270,7 +270,7 @@         global <- ask         case M.lookup (value' x) (unGlobal global) of           Just v -> return v-          Nothing -> throwInternalError $ "undefined variable: " ++ unVarName (value' x)+          Nothing -> throwInternalError $ "undefined variable: " ++ formatVarName (value' x)   List _ es -> ListVal . V.fromList <$> mapM evalExpr es   Tuple es -> TupleVal <$> mapM evalExpr es   SubscriptSlice e from to step -> do@@ -528,7 +528,7 @@ lookupGlobal x global =   case M.lookup (value' x) (unGlobal global) of     Just y -> return y-    Nothing -> throwSymbolErrorAt' (loc' x) $ "undefined variable: " ++ unVarName (value' x)+    Nothing -> throwSymbolErrorAt' (loc' x) $ "undefined variable: " ++ formatVarName (value' x)  runWithGlobal :: MonadError Error m => Global -> Expr' -> m Value runWithGlobal global e = do@@ -548,7 +548,7 @@ run :: MonadError Error m => Program -> [Value] -> m Value run prog args = wrapError' "Jikka.RestrictedPython.Evaluate" $ do   global <- makeGlobal prog-  solve <- lookupGlobal (withoutLoc (VarName "solve")) global+  solve <- lookupGlobal (withoutLoc solveVarName) global   runWithGlobal' global solve args  evalBinOp :: MonadError Error m => Value -> Operator -> Value -> m Value

@@ -30,7 +30,7 @@  formatType :: Type -> String formatType t = case t of-  VarTy x -> unTypeName x+  VarTy x -> formatTypeName x   IntTy -> "int"   BoolTy -> "bool"   ListTy t -> "List[" ++ formatType t ++ "]"@@ -104,7 +104,7 @@ formatTarget :: Target' -> String formatTarget (WithLoc' _ x) = case x of   SubscriptTrg x e -> formatTarget x ++ "[" ++ formatExpr e ++ "]"-  NameTrg x -> unVarName (value' x)+  NameTrg x -> formatVarName (value' x)   TupleTrg xs -> case xs of     [] -> "()"     [x] -> "(" ++ formatTarget x ++ ",)"@@ -117,7 +117,7 @@   UnaryOp op e -> formatUnaryOp op ++ " " ++ formatExpr e   Lambda args body -> case args of     [] -> "lambda: " ++ formatExpr body-    _ -> "lambda " ++ intercalate ", " (map (unVarName . value' . fst) args) ++ ": " ++ formatExpr body+    _ -> "lambda " ++ intercalate ", " (map (formatVarName . value' . fst) args) ++ ": " ++ formatExpr body   IfExp e1 e2 e3 -> formatExpr e2 ++ " if " ++ formatExpr e1 ++ " else " ++ formatExpr e3   ListComp e comp -> "[" ++ formatExpr e ++ " " ++ formatComprehension comp ++ "]"   Compare e1 op e2 -> formatExpr e1 ++ " " ++ formatCmpOp op ++ " " ++ formatExpr e2@@ -128,7 +128,7 @@   Attribute e (WithLoc' _ x) -> formatExpr e ++ "." ++ formatAttribute x   Subscript e1 e2 -> formatExpr e1 ++ "[" ++ formatExpr e2 ++ "]"   Starred e -> "*" ++ formatExpr e-  Name x -> unVarName (value' x)+  Name x -> formatVarName (value' x)   List _ es -> "[" ++ intercalate ", " (map formatExpr es) ++ "]"   Tuple es -> case es of     [] -> "()"@@ -157,8 +157,8 @@  formatToplevelStatement :: ToplevelStatement -> [String] formatToplevelStatement = \case-  ToplevelAnnAssign x t e -> [unVarName (value' x) ++ ": " ++ formatType t ++ " = " ++ formatExpr e]-  ToplevelFunctionDef f args ret body -> ["def " ++ unVarName (value' f) ++ "(" ++ intercalate ", " (map (\(x, t) -> unVarName (value' x) ++ ": " ++ formatType t) args) ++ ") -> " ++ formatType ret ++ ":", indent] ++ concatMap formatStatement body ++ [dedent]+  ToplevelAnnAssign x t e -> [formatVarName (value' x) ++ ": " ++ formatType t ++ " = " ++ formatExpr e]+  ToplevelFunctionDef f args ret body -> ["def " ++ formatVarName (value' f) ++ "(" ++ intercalate ", " (map (\(x, t) -> formatVarName (value' x) ++ ": " ++ formatType t) args) ++ ") -> " ++ formatType ret ++ ":", indent] ++ concatMap formatStatement body ++ [dedent]   ToplevelAssert e -> ["assert " ++ formatExpr e]  formatProgram :: Program -> [String]

@@ -126,7 +126,7 @@       e <- resolveUniqueBuiltin x       case value' e of         Constant (ConstBuiltin _) -> return e-        _ -> throwInternalError $ "not exhaustive: " ++ unVarName (value' x)+        _ -> throwInternalError $ "not exhaustive: " ++ formatVarName (value' x)  formatBuiltin :: Builtin -> String formatBuiltin = \case@@ -294,7 +294,7 @@   _ -> return $ Attribute e x resolveAttribute e@(WithLoc' _ (Name (WithLoc' _ "jikka"))) x = wrapAt' (loc' x) $ case value' x of   UnresolvedAttribute x' ->-    let x'' = VarName (unAttributeName x')+    let x'' = VarName (Just (unAttributeName x')) Nothing Nothing      in if x'' `S.notMember` additionalBuiltinNames           then throwSymbolError $ "unknown attribute: " ++ unAttributeName x'           else value' <$> resolveUniqueBuiltin (x $> x'')

@@ -12,7 +12,7 @@ module Jikka.RestrictedPython.Language.Expr   ( -- * types     TypeName (..),-    unTypeName,+    formatTypeName,     Type (..),     pattern NoneTy, @@ -31,7 +31,7 @@      -- * exprs     VarName (..),-    unVarName,+    formatVarName,     module Jikka.Common.Location,     VarName',     Expr (..),@@ -48,21 +48,30 @@   ) where -import Data.String (IsString)+import Data.String import Jikka.Common.Location+import Jikka.Common.Name import Jikka.Python.Language.Expr (BoolOp (..), CmpOp (..), Operator (..), UnaryOp (..)) -newtype VarName = VarName String deriving (Eq, Ord, Show, Read, IsString)+data VarName = VarName OccName NameFlavour (Maybe NameHint) deriving (Eq, Ord, Show, Read) -unVarName :: VarName -> String-unVarName (VarName x) = x+instance IsString VarName where+  fromString s =+    let (occ, flavour) = toFlavouredName s+     in VarName occ flavour Nothing +formatVarName :: VarName -> String+formatVarName (VarName occ flavour _) = formatFlavouredName occ flavour+ type VarName' = WithLoc' VarName -newtype TypeName = TypeName String deriving (Eq, Ord, Show, Read, IsString)+data TypeName = TypeName OccName NameFlavour deriving (Eq, Ord, Show, Read) -unTypeName :: TypeName -> String-unTypeName (TypeName x) = x+instance IsString TypeName where+  fromString = uncurry TypeName . toFlavouredName++formatTypeName :: TypeName -> String+formatTypeName (TypeName occ flavour) = formatFlavouredName occ flavour  newtype AttributeName = AttributeName String deriving (Eq, Ord, Show, Read, IsString) 

@@ -53,6 +53,11 @@      -- * programs     toplevelMainDef,++    -- * variable names+    mainVarName,+    solveVarName,+    underscoreVarName,   ) where @@ -64,18 +69,15 @@ import Jikka.RestrictedPython.Language.Expr  genType :: MonadAlpha m => m Type-genType = do-  i <- nextCounter-  return $ VarTy (TypeName ('$' : show i))+genType = VarTy . TypeName Nothing . Just <$> nextCounter  genVarName :: MonadAlpha m => VarName' -> m VarName'-genVarName x = do+genVarName x@(WithLoc' _ (VarName occ _ hint)) = do   i <- nextCounter-  let base = if unVarName (value' x) == "_" then "" else takeWhile (/= '$') (unVarName (value' x))-  return $ WithLoc' (loc' x) (VarName (base ++ '$' : show i))+  return . WithLoc' (loc' x) $ VarName occ (Just i) hint  genVarName' :: MonadAlpha m => m VarName'-genVarName' = genVarName (withoutLoc (VarName "_"))+genVarName' = genVarName (withoutLoc underscoreVarName)  freeTyVars :: Type -> [TypeName] freeTyVars = nub . go@@ -353,4 +355,13 @@     SubscriptTrg e1 e2 -> Subscript (targetToExpr e1) e2  toplevelMainDef :: [Statement] -> Program-toplevelMainDef body = [ToplevelFunctionDef (WithLoc' Nothing (VarName "main")) [] IntTy body]+toplevelMainDef body = [ToplevelFunctionDef (WithLoc' Nothing mainVarName) [] IntTy body]++mainVarName :: VarName+mainVarName = VarName (Just "main") Nothing Nothing++solveVarName :: VarName+solveVarName = VarName (Just "solve") Nothing Nothing++underscoreVarName :: VarName+underscoreVarName = VarName Nothing Nothing Nothing

@@ -5,8 +5,10 @@   ) where +import qualified Jikka.CPlusPlus.Convert.BurnFlavouredNames as Y_BurnFlavouredNames import Jikka.CPlusPlus.Convert.FromCore import qualified Jikka.CPlusPlus.Language.Expr as Y+import qualified Jikka.CPlusPlus.Language.Util as Y import Jikka.Common.Alpha import Jikka.Common.Error import qualified Jikka.Core.Language.BuiltinPatterns as X@@ -14,7 +16,9 @@ import Test.Hspec  run' :: X.Program -> Either Error Y.Program-run' = flip evalAlphaT 0 . run+run' prog = flip evalAlphaT 0 $ do+  prog <- run prog+  Y_BurnFlavouredNames.run prog  spec :: Spec spec = describe "run" $ do@@ -34,35 +38,35 @@     let expectedF =           Y.FunDef             Y.TyInt64-            "f_0"-            [(Y.TyInt64, "n_1")]-            [ Y.Declare Y.TyInt64 "x2" Y.DeclareDefault,+            "f"+            [(Y.TyInt64, "n")]+            [ Y.Declare Y.TyInt64 "x" Y.DeclareDefault,               Y.If-                (Y.BinOp Y.Equal (Y.Var "n_1") (Y.Lit (Y.LitInt64 0)))-                [Y.Assign (Y.AssignExpr Y.SimpleAssign (Y.LeftVar "x2") (Y.Lit (Y.LitInt64 1)))]+                (Y.BinOp Y.Equal (Y.Var "n") (Y.Lit (Y.LitInt64 0)))+                [Y.Assign (Y.AssignExpr Y.SimpleAssign (Y.LeftVar "x") (Y.Lit (Y.LitInt64 1)))]                 ( Just                     [ Y.Assign                         ( Y.AssignExpr                             Y.SimpleAssign-                            (Y.LeftVar "x2")+                            (Y.LeftVar "x")                             ( Y.BinOp                                 Y.Mul-                                (Y.Var "n_1")-                                ( Y.CallExpr-                                    (Y.Var "f_0")-                                    [Y.BinOp Y.Sub (Y.Var "n_1") (Y.Lit (Y.LitInt64 1))]+                                (Y.Var "n")+                                ( Y.Call'+                                    (Y.Function "f" [])+                                    [Y.BinOp Y.Sub (Y.Var "n") (Y.Lit (Y.LitInt64 1))]                                 )                             )                         )                     ]                 ),-              Y.Return (Y.Var "x2")+              Y.Return (Y.Var "x")             ]     let expectedSolve =           Y.FunDef             Y.TyInt64             "solve"-            [(Y.TyInt64, "a3")]-            [Y.Return (Y.CallExpr (Y.Var "f_0") [Y.Var "a3"])]+            [(Y.TyInt64, "a")]+            [Y.Return (Y.Call' (Y.Function "f" []) [Y.Var "a"])]     let expected = Y.Program [expectedF, expectedSolve]     run' prog `shouldBe` Right expected

@@ -7,6 +7,7 @@  import Jikka.CPlusPlus.Convert.MoveSemantics import Jikka.CPlusPlus.Language.Expr+import Jikka.CPlusPlus.Language.Util import Jikka.Common.Alpha import Jikka.Common.Error import Test.Hspec@@ -52,10 +53,10 @@                 "func"                 [(TyVector TyInt32, "a")]                 [ Declare (TyVector TyInt32) "b" (DeclareCopy (Var "a")),-                  ExprStatement (Call (Method "push_back") [Var "b", Lit (LitInt32 10)]),+                  ExprStatement (Call' (Method "push_back") [Var "b", Lit (LitInt32 10)]),                   Declare (TyVector TyInt32) "c" (DeclareCopy (Var "b")),-                  ExprStatement (Call (Method "push_back") [Var "b", Lit (LitInt32 10)]),-                  Return (BinOp Add (Call MethodSize [Var "b"]) (Call MethodSize [Var "c"]))+                  ExprStatement (Call' (Method "push_back") [Var "b", Lit (LitInt32 10)]),+                  Return (BinOp Add (Call' MethodSize [Var "b"]) (Call' MethodSize [Var "c"]))                 ]             ]     let expected =@@ -64,10 +65,10 @@                 TyInt32                 "func"                 [(TyVector TyInt32, "a")]-                [ ExprStatement (Call (Method "push_back") [Var "a", Lit (LitInt32 10)]),+                [ ExprStatement (Call' (Method "push_back") [Var "a", Lit (LitInt32 10)]),                   Declare (TyVector TyInt32) "c" (DeclareCopy (Var "a")),-                  ExprStatement (Call (Method "push_back") [Var "a", Lit (LitInt32 10)]),-                  Return (BinOp Add (Call MethodSize [Var "a"]) (Call MethodSize [Var "c"]))+                  ExprStatement (Call' (Method "push_back") [Var "a", Lit (LitInt32 10)]),+                  Return (BinOp Add (Call' MethodSize [Var "a"]) (Call' MethodSize [Var "c"]))                 ]             ]     run' prog `shouldBe` Right expected@@ -127,7 +128,7 @@                 "func"                 [(TyVector TyInt32, "a")]                 [ Declare (TyVector TyInt32) "b" (DeclareCopy (Var "a")),-                  Assign (AssignExpr AddAssign (LeftAt (LeftVar "b") (Lit (LitInt32 0))) (Call At [Var "a", Lit (LitInt32 1)])),+                  Assign (AssignExpr AddAssign (LeftAt (LeftVar "b") (Lit (LitInt32 0))) (Call' At [Var "a", Lit (LitInt32 1)])),                   Assign (AssignExpr SimpleAssign (LeftVar "a") (Var "b")),                   Return (Var "a")                 ]@@ -138,7 +139,7 @@                 (TyVector TyInt32)                 "func"                 [(TyVector TyInt32, "a")]-                [ Assign (AssignExpr AddAssign (LeftAt (LeftVar "a") (Lit (LitInt32 0))) (Call At [Var "a", Lit (LitInt32 1)])),+                [ Assign (AssignExpr AddAssign (LeftAt (LeftVar "a") (Lit (LitInt32 0))) (Call' At [Var "a", Lit (LitInt32 1)])),                   Return (Var "a")                 ]             ]

@@ -5,14 +5,18 @@   ) where +import qualified Jikka.CPlusPlus.Convert.BurnFlavouredNames as Y_BurnFlavouredNames import Jikka.CPlusPlus.Convert.UnpackTuples import Jikka.CPlusPlus.Language.Expr+import Jikka.CPlusPlus.Language.Util import Jikka.Common.Alpha import Jikka.Common.Error import Test.Hspec  run' :: Program -> Either Error Program-run' = flip evalAlphaT 0 . run+run' prog = flip evalAlphaT 0 $ do+  prog <- run prog+  Y_BurnFlavouredNames.run prog  spec :: Spec spec = describe "run" $ do@@ -23,8 +27,8 @@                 TyInt                 "func"                 [(TyInt, "a")]-                [ Declare (TyTuple [TyInt, TyBool]) "b" (DeclareCopy (Call (StdTuple [TyInt, TyBool]) [Var "a", Lit (LitBool True)])),-                  Return (BinOp Add (Call (StdGet 0) [Var "b"]) (Call (StdGet 1) [Var "b"]))+                [ Declare (TyTuple [TyInt, TyBool]) "b" (DeclareCopy (Call' (StdTuple [TyInt, TyBool]) [Var "a", Lit (LitBool True)])),+                  Return (BinOp Add (Call' (StdGet 0) [Var "b"]) (Call' (StdGet 1) [Var "b"]))                 ]             ]     let expected =@@ -33,9 +37,9 @@                 TyInt                 "func"                 [(TyInt, "a")]-                [ Declare TyInt "b_0" (DeclareCopy (Var "a")),-                  Declare TyBool "b_1" (DeclareCopy (Lit (LitBool True))),-                  Return (BinOp Add (Var "b_0") (Var "b_1"))+                [ Declare TyInt "b" (DeclareCopy (Var "a")),+                  Declare TyBool "b2" (DeclareCopy (Lit (LitBool True))),+                  Return (BinOp Add (Var "b") (Var "b2"))                 ]             ]     run' prog `shouldBe` Right expected@@ -46,8 +50,8 @@                 TyInt32                 "func"                 [(TyInt32, "a")]-                [ Declare (TyArray TyInt32 3) "b" (DeclareCopy (Call (ArrayExt TyInt32) [Var "a", Lit (LitInt32 10), Lit (LitInt32 15)])),-                  Return (BinOp Add (Call At [Var "b", Lit (LitInt32 0)]) (Call At [Var "b", Lit (LitInt32 2)]))+                [ Declare (TyArray TyInt32 3) "b" (DeclareCopy (Call' (ArrayExt TyInt32) [Var "a", Lit (LitInt32 10), Lit (LitInt32 15)])),+                  Return (BinOp Add (Call' At [Var "b", Lit (LitInt32 0)]) (Call' At [Var "b", Lit (LitInt32 2)]))                 ]             ]     let expected =@@ -56,10 +60,10 @@                 TyInt32                 "func"                 [(TyInt32, "a")]-                [ Declare TyInt32 "b_0" (DeclareCopy (Var "a")),-                  Declare TyInt32 "b_1" (DeclareCopy (Lit (LitInt32 10))),-                  Declare TyInt32 "b_2" (DeclareCopy (Lit (LitInt32 15))),-                  Return (BinOp Add (Var "b_0") (Var "b_2"))+                [ Declare TyInt32 "b" (DeclareCopy (Var "a")),+                  Declare TyInt32 "b2" (DeclareCopy (Lit (LitInt32 10))),+                  Declare TyInt32 "b3" (DeclareCopy (Lit (LitInt32 15))),+                  Return (BinOp Add (Var "b") (Var "b3"))                 ]             ]     run' prog `shouldBe` Right expected

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ module Jikka.CPlusPlus.FormatSpec   ( spec,   )@@ -6,6 +8,7 @@ import Data.List import Jikka.CPlusPlus.Format import Jikka.CPlusPlus.Language.Expr+import Jikka.CPlusPlus.Language.Util import Test.Hspec  run'' :: Program -> [String]@@ -19,18 +22,18 @@             Program               [ FunDef                   TyInt64-                  (VarName "solve")-                  [(TyInt32, VarName "n")]-                  [ Declare TyInt64 (VarName "x") (DeclareCopy (Lit (LitInt64 0))),+                  "solve"+                  [(TyInt32, "n")]+                  [ Declare TyInt64 "x" (DeclareCopy (Lit (LitInt64 0))),                     For                       TyInt32-                      (VarName "i")+                      "i"                       (Lit (LitInt32 0))-                      (BinOp LessThan (Var (VarName "i")) (Var (VarName "n")))-                      (AssignIncr (LeftVar (VarName "i")))-                      [ Assign (AssignExpr AddAssign (LeftVar (VarName "x")) (Call (Cast TyInt64) [Var (VarName "i")]))+                      (BinOp LessThan (Var "i") (Var "n"))+                      (AssignIncr (LeftVar "i"))+                      [ Assign (AssignExpr AddAssign (LeftVar "x") (Call' (Cast TyInt64) [Var "i"]))                       ],-                    Return (Var (VarName "x"))+                    Return (Var "x")                   ]               ]       let formatted =@@ -49,18 +52,18 @@             Program               [ FunDef                   TyInt64-                  (VarName "solve")-                  [(TyInt32, VarName "n"), (TyVector TyInt64, VarName "h")]-                  [ Declare TyInt64 (VarName "x") (DeclareCopy (Lit (LitInt64 0))),+                  "solve"+                  [(TyInt32, "n"), (TyVector TyInt64, "h")]+                  [ Declare TyInt64 "x" (DeclareCopy (Lit (LitInt64 0))),                     For                       TyInt32-                      (VarName "i")+                      "i"                       (Lit (LitInt32 2))-                      (BinOp LessThan (Var (VarName "i")) (Var (VarName "n")))-                      (AssignIncr (LeftVar (VarName "i")))-                      [ Assign (AssignExpr AddAssign (LeftVar (VarName "x")) (Call At [Var (VarName "h"), BinOp Sub (Var (VarName "i")) (Lit (LitInt32 2))]))+                      (BinOp LessThan (Var "i") (Var "n"))+                      (AssignIncr (LeftVar "i"))+                      [ Assign (AssignExpr AddAssign (LeftVar "x") (Call' At [Var "h", BinOp Sub (Var "i") (Lit (LitInt32 2))]))                       ],-                    Return (Var (VarName "x"))+                    Return (Var "x")                   ]               ]       let formatted =

@@ -8,30 +8,40 @@ import Jikka.Common.Alpha import Jikka.Common.Error import Jikka.Core.Convert.Eta (run)-import Jikka.Core.Language.BuiltinPatterns+import qualified Jikka.Core.Convert.TypeInfer as TypeInfer import Jikka.Core.Language.Expr+import Jikka.Core.Parse (parseProgram) import Test.Hspec  run' :: Program -> Either Error Program run' = flip evalAlphaT 0 . run +parseProgram' :: [String] -> Program+parseProgram' = fromSuccess . flip evalAlphaT 100 . (TypeInfer.run <=< parseProgram . unlines)+ spec :: Spec spec = describe "run" $ do-  it "works" $ do+  it "works on a let" $ do     let prog =-          ResultExpr-            ( Let-                "plus"-                (FunTy IntTy (FunTy IntTy IntTy))-                (Builtin Plus)-                (Var "plus")-            )+          parseProgram'+            [ "fun (n: int) ->",+              "    let f = sum",+              "    in f"+            ]     let expected =-          ResultExpr-            ( Let-                "plus"-                (FunTy IntTy (FunTy IntTy IntTy))-                (Lam "$0" IntTy (Lam "$1" IntTy (Plus' (Var "$0") (Var "$1"))))-                (Var "plus")-            )+          parseProgram'+            [ "fun (n: int) ->",+              "    let f = fun $0 -> sum $0",+              "    in f"+            ]+    run' prog `shouldBe` Right expected+  it "works in map" $ do+    let prog =+          parseProgram'+            [ "map sum nil"+            ]+    let expected =+          parseProgram'+            [ "map (fun $0 -> sum $0) nil"+            ]     run' prog `shouldBe` Right expected

@@ -8,8 +8,8 @@ import Jikka.Common.Alpha import Jikka.Common.Error import Jikka.Core.Convert.TypeInfer (run, runExpr)-import Jikka.Core.Language.BuiltinPatterns import Jikka.Core.Language.Expr+import Jikka.Core.Parse (parseExpr, parseProgram) import Test.Hspec  run' :: Program -> Either Error Program@@ -18,105 +18,93 @@ runExpr' :: [(VarName, Type)] -> Expr -> Either Error Expr runExpr' env = flip evalAlphaT 0 . runExpr env +parseExpr' :: [String] -> Expr+parseExpr' = fromSuccess . flip evalAlphaT 100 . parseExpr . unlines++parseProgram' :: [String] -> Program+parseProgram' = fromSuccess . flip evalAlphaT 100 . parseProgram . unlines+ spec :: Spec spec = do   describe "run" $ do     it "works" $ do       let prog =-            ResultExpr-              ( Let-                  "x"-                  (VarTy "t1")-                  Lit0-                  ( Let-                      "y"-                      (VarTy "t2")-                      (Plus' (Var "x") Lit1)-                      (Var "y")-                  )-              )+            parseProgram'+              [ "let x: t1 = 0",+                "in let y: t2 = x + 1",+                "in y"+              ]       let expected =-            ResultExpr-              ( Let-                  "x"-                  IntTy-                  Lit0-                  ( Let-                      "y"-                      IntTy-                      (Plus' (Var "x") Lit1)-                      (Var "y")-                  )-              )+            parseProgram'+              [ "let x: int = 0",+                "in let y: int = x + 1",+                "in y"+              ]       run' prog `shouldBe` Right expected     it "works on let-rec" $ do       let prog =-            ToplevelLetRec-              "f"-              [("x", VarTy "t1")]-              (VarTy "t2")-              (Var "x")-              (ResultExpr (App (Var "f") Lit0))+            parseProgram'+              [ "let rec f (x: t1): t2 = x",+                "in f 0"+              ]       let expected =-            ToplevelLetRec-              "f"-              [("x", IntTy)]-              IntTy-              (Var "x")-              (ResultExpr (App (Var "f") Lit0))+            parseProgram'+              [ "let rec f (x: int): int = x",+                "in f 0"+              ]       run' prog `shouldBe` Right expected     it "replaces undetermined types with 0-tuples" $ do       let prog =-            ToplevelLetRec-              "f"-              [("x", VarTy "t1")]-              (VarTy "t2")-              (Var "x")-              (ResultExpr Lit0)+            parseProgram'+              [ "let rec f (x: t1): t2 = x",+                "in 0"+              ]       let expected =-            ToplevelLetRec-              "f"-              [("x", TupleTy [])]-              (TupleTy [])-              (Var "x")-              (ResultExpr Lit0)+            parseProgram'+              [ "let rec f (x: unit): unit = x",+                "in 0"+              ]       run' prog `shouldBe` Right expected     it "works on builtin functions" $ do       let prog =-            ToplevelLetRec-              "solve"-              [("n", IntTy)]-              IntTy-              ( If'-                  (VarTy "$0")-                  (Equal' IntTy (Var "n") Lit0)-                  Lit1-                  ( Mult'-                      (Var "n")-                      (App (Var "solve") (Minus' (Var "n") Lit1))-                  )-              )-              (ResultExpr (Var "solve"))+            parseProgram'+              [ "let rec solve (n: t0): t1 =",+                "    if@t2 n ==@t3 0",+                "    then 1",+                "    else n * solve (n - 1)",+                "in solve"+              ]       let expected =-            ToplevelLetRec-              "solve"-              [("n", IntTy)]-              IntTy-              ( If'-                  IntTy-                  (Equal' IntTy (Var "n") Lit0)-                  Lit1-                  ( Mult'-                      (Var "n")-                      (App (Var "solve") (Minus' (Var "n") Lit1))-                  )-              )-              (ResultExpr (Var "solve"))+            parseProgram'+              [ "let rec solve (n: int): int =",+                "    if@int n ==@int 0",+                "    then 1",+                "    else n * solve (n - 1)",+                "in solve"+              ]       run' prog `shouldBe` Right expected    describe "runExpr" $ do-    it "works" $ do-      let e = Equal' (VarTy "t1") (Var "xs") (Nil' (VarTy "t2"))-      let env = [("xs", ListTy IntTy)]-      let expected = Equal' (ListTy IntTy) (Var "xs") (Nil' IntTy)+    it "works on an equation" $ do+      let env = [("xs", ListTy BoolTy)]+      let e =+            parseExpr'+              [ "xs ==@t1 nil@t2"+              ]+      let expected =+            parseExpr'+              [ "xs ==@(bool list) nil@bool"+              ]+      runExpr' env e `shouldBe` Right expected++    it "works on lambdas and applications" $ do+      let env = [("f", Fun3Ty IntTy BoolTy UnitTy (ListTy IntTy))]+      let e =+            parseExpr'+              [ "fun x y z -> f x y z"+              ]+      let expected =+            parseExpr'+              [ "fun (x: int) (y: bool) (z: unit) -> f x y z"+              ]       runExpr' env e `shouldBe` Right expected

@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}++module Jikka.Core.Language.EtaSpec+  ( spec,+  )+where++import Jikka.Common.Alpha+import Jikka.Common.Error+import qualified Jikka.Core.Convert.TypeInfer as TypeInfer+import Jikka.Core.Language.Eta+import Jikka.Core.Language.Expr+import Jikka.Core.Parse (parseExpr)+import Test.Hspec++etaExpand'' :: [(VarName, Type)] -> Expr -> Either Error (Maybe Expr)+etaExpand'' env = flip evalAlphaT 0 . etaExpand' env++parseExpr' :: [(VarName, Type)] -> [String] -> Expr+parseExpr' env = fromSuccess . flip evalAlphaT 100 . (TypeInfer.runExpr env <=< parseExpr . unlines)++spec :: Spec+spec = do+  describe "etaExpand'" $ do+    it "works on sum" $ do+      let env = []+      let e =+            parseExpr'+              env+              [ "sum"+              ]+      let expected =+            parseExpr'+              env+              [ "fun $0 -> sum $0"+              ]+      etaExpand'' env e `shouldBe` Right (Just expected)+    it "works on let" $ do+      let env = []+      let e =+            parseExpr'+              env+              [ "let f = fun x y -> x + y",+                "in f"+              ]+      let expected =+            parseExpr'+              env+              [ "fun $0 $1 ->",+                "    (let f = fun x y -> x + y",+                "    in f) $0 $1"+              ]+      etaExpand'' env e `shouldBe` Right (Just expected)+    it "works on a partial lambda" $ do+      let env = [("f", Fun3Ty IntTy BoolTy UnitTy (ListTy IntTy))]+      let e =+            parseExpr'+              env+              [ "fun (x: int) -> f x"+              ]+      let expected =+            parseExpr'+              env+              [ "fun (x: int) ($0: bool) ($1: unit) -> f x $0 $1"+              ]+      etaExpand'' env e `shouldBe` Right (Just expected)+    it "does nothing on integers" $ do+      let env = []+      let e =+            parseExpr'+              env+              [ "12"+              ]+      etaExpand'' env e `shouldBe` Right Nothing++  describe "etaReduce'" $ do+    it "works on sum" $ do+      let env = []+      let e =+            parseExpr'+              env+              [ "fun $0 -> sum $0"+              ]+      let expected =+            parseExpr'+              env+              [ "sum"+              ]+      etaReduce' e `shouldBe` Just expected+    it "works on an application which is longer than lambda abstraction" $ do+      let env = [("f", Fun3STy IntTy)]+      let e =+            parseExpr'+              env+              [ "fun x y -> f 12 x y"+              ]+      let expected =+            parseExpr'+              env+              [ "f 12"+              ]+      etaReduce' e `shouldBe` Just expected+    it "does nothing on a flipped application" $ do+      let env = [("f", Fun2STy IntTy)]+      let e =+            parseExpr'+              env+              [ "fun x y -> f y x"+              ]+      etaReduce' e `shouldBe` Nothing