{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}

-- |
-- Module      : Jikka.Core.Convert.Alpha
-- Description : does alpha-conversion. / alpha 変換をします。
-- Copyright   : (c) Kimiyuki Onaka, 2020
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.Core.Convert.Alpha where

import Jikka.Common.Alpha
import Jikka.Common.Error
import Jikka.Core.Language.Expr

rename :: MonadAlpha m => VarName -> m VarName
rename :: VarName -> m VarName
rename VarName
x = do
  let base :: [Char]
base = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'$') (VarName -> [Char]
unVarName VarName
x)
  Int
i <- m Int
forall (m :: * -> *). MonadAlpha m => m Int
nextCounter
  VarName -> m VarName
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName -> m VarName) -> VarName -> m VarName
forall a b. (a -> b) -> a -> b
$ [Char] -> VarName
VarName ([Char]
base [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"$" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)

runExpr :: (MonadAlpha m, MonadError Error m) => [(VarName, VarName)] -> Expr -> m Expr
runExpr :: [(VarName, VarName)] -> Expr -> m Expr
runExpr [(VarName, VarName)]
env = \case
  Var VarName
x -> case VarName -> [(VarName, VarName)] -> Maybe VarName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup VarName
x [(VarName, VarName)]
env of
    Maybe VarName
Nothing -> [Char] -> m Expr
forall (m :: * -> *) a. MonadError Error m => [Char] -> m a
throwInternalError ([Char] -> m Expr) -> [Char] -> m Expr
forall a b. (a -> b) -> a -> b
$ [Char]
"undefined variable: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ VarName -> [Char]
unVarName VarName
x
    Just VarName
y -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Var VarName
y
  Lit Literal
lit -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Literal -> Expr
Lit Literal
lit
  App Expr
f Expr
e -> Expr -> Expr -> Expr
App (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(VarName, VarName)] -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> Expr -> m Expr
runExpr [(VarName, VarName)]
env Expr
f m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(VarName, VarName)] -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> Expr -> m Expr
runExpr [(VarName, VarName)]
env Expr
e
  Lam VarName
x Type
t Expr
body -> do
    VarName
y <- VarName -> m VarName
forall (m :: * -> *). MonadAlpha m => VarName -> m VarName
rename VarName
x
    Expr
body <- [(VarName, VarName)] -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> Expr -> m Expr
runExpr ((VarName
x, VarName
y) (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. a -> [a] -> [a]
: [(VarName, VarName)]
env) Expr
body
    Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> Expr
Lam VarName
y Type
t Expr
body
  Let VarName
x Type
t Expr
e1 Expr
e2 -> do
    Expr
e1 <- [(VarName, VarName)] -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> Expr -> m Expr
runExpr [(VarName, VarName)]
env Expr
e1
    VarName
y <- VarName -> m VarName
forall (m :: * -> *). MonadAlpha m => VarName -> m VarName
rename VarName
x
    Expr
e2 <- [(VarName, VarName)] -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> Expr -> m Expr
runExpr ((VarName
x, VarName
y) (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. a -> [a] -> [a]
: [(VarName, VarName)]
env) Expr
e2
    Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> Expr -> Expr
Let VarName
y Type
t Expr
e1 Expr
e2

runToplevelExpr :: (MonadAlpha m, MonadError Error m) => [(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
runToplevelExpr :: [(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
runToplevelExpr [(VarName, VarName)]
env = \case
  ResultExpr Expr
e -> Expr -> ToplevelExpr
ResultExpr (Expr -> ToplevelExpr) -> m Expr -> m ToplevelExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(VarName, VarName)] -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> Expr -> m Expr
runExpr [(VarName, VarName)]
env Expr
e
  ToplevelLet VarName
x Type
t Expr
e ToplevelExpr
cont -> do
    VarName
y <- VarName -> m VarName
forall (m :: * -> *). MonadAlpha m => VarName -> m VarName
rename VarName
x
    Expr
e <- [(VarName, VarName)] -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> Expr -> m Expr
runExpr [(VarName, VarName)]
env Expr
e
    ToplevelExpr
cont <- [(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
runToplevelExpr ((VarName
x, VarName
y) (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. a -> [a] -> [a]
: [(VarName, VarName)]
env) ToplevelExpr
cont
    ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (ToplevelExpr -> m ToplevelExpr) -> ToplevelExpr -> m ToplevelExpr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> ToplevelExpr -> ToplevelExpr
ToplevelLet VarName
y Type
t Expr
e ToplevelExpr
cont
  ToplevelLetRec VarName
f [(VarName, Type)]
args Type
ret Expr
body ToplevelExpr
cont -> do
    VarName
g <- VarName -> m VarName
forall (m :: * -> *). MonadAlpha m => VarName -> m VarName
rename VarName
f
    [(VarName, VarName, Type)]
args <- [(VarName, Type)]
-> ((VarName, Type) -> m (VarName, VarName, Type))
-> m [(VarName, VarName, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VarName, Type)]
args (((VarName, Type) -> m (VarName, VarName, Type))
 -> m [(VarName, VarName, Type)])
-> ((VarName, Type) -> m (VarName, VarName, Type))
-> m [(VarName, VarName, Type)]
forall a b. (a -> b) -> a -> b
$ \(VarName
x, Type
t) -> do
      VarName
y <- VarName -> m VarName
forall (m :: * -> *). MonadAlpha m => VarName -> m VarName
rename VarName
x
      (VarName, VarName, Type) -> m (VarName, VarName, Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName
x, VarName
y, Type
t)
    let args1 :: [(VarName, VarName)]
args1 = ((VarName, VarName, Type) -> (VarName, VarName))
-> [(VarName, VarName, Type)] -> [(VarName, VarName)]
forall a b. (a -> b) -> [a] -> [b]
map (\(VarName
x, VarName
y, Type
_) -> (VarName
x, VarName
y)) [(VarName, VarName, Type)]
args
    let args2 :: [(VarName, Type)]
args2 = ((VarName, VarName, Type) -> (VarName, Type))
-> [(VarName, VarName, Type)] -> [(VarName, Type)]
forall a b. (a -> b) -> [a] -> [b]
map (\(VarName
_, VarName
y, Type
t) -> (VarName
y, Type
t)) [(VarName, VarName, Type)]
args
    Expr
body <- [(VarName, VarName)] -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> Expr -> m Expr
runExpr ([(VarName, VarName)]
args1 [(VarName, VarName)]
-> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. [a] -> [a] -> [a]
++ (VarName
f, VarName
g) (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. a -> [a] -> [a]
: [(VarName, VarName)]
env) Expr
body
    ToplevelExpr
cont <- [(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
runToplevelExpr ((VarName
f, VarName
g) (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. a -> [a] -> [a]
: [(VarName, VarName)]
env) ToplevelExpr
cont
    ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (ToplevelExpr -> m ToplevelExpr) -> ToplevelExpr -> m ToplevelExpr
forall a b. (a -> b) -> a -> b
$ VarName
-> [(VarName, Type)]
-> Type
-> Expr
-> ToplevelExpr
-> ToplevelExpr
ToplevelLetRec VarName
g [(VarName, Type)]
args2 Type
ret Expr
body ToplevelExpr
cont

runProgram :: (MonadAlpha m, MonadError Error m) => Program -> m Program
runProgram :: ToplevelExpr -> m ToplevelExpr
runProgram = [(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
runToplevelExpr []

-- | `run` renames variables in exprs to avoid name conflictions, even if the scopes of two variables are distinct.
--
-- == Examples
--
-- Before:
--
-- > let x = 0
-- > in y = x + x
-- > in x = x + y
-- > x + y
--
-- After:
--
-- > let x0 = 0
-- > in y1 = x0 + x0
-- > in x2 = x0 + y1
-- > x2 + y1
run :: (MonadAlpha m, MonadError Error m) => Program -> m Program
run :: ToplevelExpr -> m ToplevelExpr
run ToplevelExpr
prog = [Char] -> m ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *) a. MonadError Error m => [Char] -> m a -> m a
wrapError' [Char]
"Jikka.Core.Convert.Alpha" (m ToplevelExpr -> m ToplevelExpr)
-> m ToplevelExpr -> m ToplevelExpr
forall a b. (a -> b) -> a -> b
$ do
  [(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, VarName)] -> ToplevelExpr -> m ToplevelExpr
runToplevelExpr [] ToplevelExpr
prog