Skip to content
Permalink
Browse files

Merge pull request #1127 from michaelpj/imp/let-strictenss

plutus-ir: allow lets to be strict or non-strict
  • Loading branch information...
michaelpj committed Jun 12, 2019
2 parents 6a4a1d9 + 3861d53 commit 183d15678778581cb698ec2939960e6928774add
Showing with 478 additions and 418 deletions.
  1. +1 −0 plutus-ir/plutus-ir.cabal
  2. +25 −6 plutus-ir/src/Language/PlutusIR.hs
  3. +1 −1 plutus-ir/src/Language/PlutusIR/Analysis/Dependencies.hs
  4. +5 −1 plutus-ir/src/Language/PlutusIR/Compiler.hs
  5. +8 −5 plutus-ir/src/Language/PlutusIR/Compiler/Definitions.hs
  6. +3 −3 plutus-ir/src/Language/PlutusIR/Compiler/Let.hs
  7. +1 −1 plutus-ir/src/Language/PlutusIR/Compiler/Recursion.hs
  8. +4 −1 plutus-ir/src/Language/PlutusIR/Generators/AST.hs
  9. +1 −1 plutus-ir/src/Language/PlutusIR/Optimizer/DeadCode.hs
  10. +6 −1 plutus-ir/src/Language/PlutusIR/Parser.hs
  11. +59 −0 plutus-ir/src/Language/PlutusIR/Transform/NonStrict.hs
  12. +5 −5 plutus-ir/src/Language/PlutusIR/Transform/Rename.hs
  13. +19 −142 plutus-ir/src/Language/PlutusIR/Transform/ThunkRecursions.hs
  14. +2 −15 plutus-ir/src/Language/PlutusIR/Value.hs
  15. +10 −2 plutus-ir/test/TransformSpec.hs
  16. +2 −2 plutus-ir/test/lets/letInLet
  17. +1 −1 plutus-ir/test/optimizer/deadCode/nestedBindings
  18. +3 −1 plutus-ir/test/optimizer/deadCode/nestedBindings.golden
  19. +1 −1 plutus-ir/test/optimizer/deadCode/recBindingComplex
  20. +3 −1 plutus-ir/test/optimizer/deadCode/recBindingComplex.golden
  21. +1 −1 plutus-ir/test/optimizer/deadCode/recBindingSimple
  22. +1 −1 plutus-ir/test/optimizer/deadCode/singleBinding
  23. +3 −1 plutus-ir/test/optimizer/deadCode/singleBinding.golden
  24. +1 −1 plutus-ir/test/optimizer/deadCode/termLet
  25. +3 −3 plutus-ir/test/recursion/even3
  26. +3 −3 plutus-ir/test/recursion/even3Eval
  27. +2 −2 plutus-ir/test/recursion/mutuallyRecursiveValues
  28. +5 −8 plutus-ir/test/recursion/mutuallyRecursiveValues.golden
  29. +3 −3 plutus-ir/test/serialization/serializeEvenOdd
  30. +3 −1 plutus-ir/test/serialization/serializeEvenOdd.golden
  31. +7 −0 plutus-ir/test/transform/nonStrict/nonStrict1
  32. +9 −0 plutus-ir/test/transform/nonStrict/nonStrict1.golden
  33. +1 −1 plutus-ir/test/transform/thunkRecursions/listFold
  34. +15 −42 plutus-ir/test/transform/thunkRecursions/listFold.golden
  35. +1 −1 plutus-ir/test/transform/thunkRecursions/monoMap
  36. +2 −0 plutus-ir/test/transform/thunkRecursions/monoMap.golden
  37. +1 −1 plutus-tx/compiler/Language/PlutusTx/Compiler/Builtins.hs
  38. +26 −50 plutus-tx/compiler/Language/PlutusTx/Compiler/Expr.hs
  39. +1 −12 plutus-tx/compiler/Language/PlutusTx/Compiler/Types.hs
  40. +1 −1 plutus-tx/compiler/Language/PlutusTx/Plugin.hs
  41. +1 −0 plutus-tx/test/Plugin/Basic/letFun.plc.golden
  42. +4 −1 plutus-tx/test/Plugin/Data/monomorphic/atPattern.plc.golden
  43. +1 −0 plutus-tx/test/Plugin/Data/monomorphic/nonValueCase.plc.golden
  44. +2 −0 plutus-tx/test/Plugin/Data/recursive/listConstruct2.plc.golden
  45. +8 −9 plutus-tx/test/Plugin/Functions/recursive/even.plc.golden
  46. +2 −2 plutus-tx/test/Plugin/Functions/recursive/even3.plc.golden
  47. +2 −2 plutus-tx/test/Plugin/Functions/recursive/even4.plc.golden
  48. +4 −0 plutus-tx/test/Plugin/Functions/recursive/fib.plc.golden
  49. +2 −0 plutus-tx/test/Plugin/Functions/recursive/sum.plc.golden
  50. +39 −12 plutus-tx/test/Plugin/Functions/unfoldings/allDirect.plc.golden
  51. +16 −1 plutus-tx/test/Plugin/Functions/unfoldings/andDirect.plc.golden
  52. +31 −10 plutus-tx/test/Plugin/Functions/unfoldings/andExternal.plc.golden
  53. +4 −0 plutus-tx/test/Plugin/Functions/unfoldings/mutualRecursionUnfoldings.plc.golden
  54. +15 −1 plutus-tx/test/Plugin/Functions/unfoldings/nandDirect.plc.golden
  55. +5 −0 plutus-tx/test/Plugin/Functions/unfoldings/polyMap.plc.golden
  56. +1 −0 plutus-tx/test/Plugin/Functions/unfoldings/recordSelector.plc.golden
  57. +1 −0 plutus-tx/test/Plugin/Functions/unfoldings/recordSelectorExternal.plc.golden
  58. +4 −5 plutus-tx/test/Plugin/Laziness/joinError.plc.golden
  59. +1 −1 plutus-tx/test/Plugin/Laziness/joinErrorEval.plc.golden
  60. +10 −14 plutus-tx/test/Plugin/Laziness/lazyDepUnit.plc.golden
  61. +21 −1 plutus-tx/test/Plugin/Primitives/and.plc.golden
  62. +1 −0 plutus-tx/test/Plugin/Primitives/error.plc.golden
  63. +22 −6 plutus-tx/test/Plugin/Primitives/ifThenElse.plc.golden
  64. +1 −0 plutus-tx/test/Plugin/Primitives/intCompare.plc.golden
  65. +1 −0 plutus-tx/test/Plugin/Primitives/intDiv.plc.golden
  66. +1 −0 plutus-tx/test/Plugin/Primitives/intEq.plc.golden
  67. +1 −0 plutus-tx/test/Plugin/Primitives/intPlus.plc.golden
  68. +1 −0 plutus-tx/test/Plugin/Primitives/trace.plc.golden
  69. +2 −0 plutus-tx/test/Plugin/Primitives/verify.plc.golden
  70. +2 −0 plutus-tx/test/Plugin/Primitives/void.plc.golden
  71. +2 −2 plutus-tx/test/TH/all.plc.golden
  72. +21 −29 plutus-tx/test/TH/power.plc.golden
@@ -38,6 +38,7 @@ library
Language.PlutusIR.Transform.Substitute
Language.PlutusIR.Transform.ThunkRecursions
Language.PlutusIR.Transform.Rename
Language.PlutusIR.Transform.NonStrict
hs-source-dirs: src
other-modules:
Language.PlutusIR.Analysis.Dependencies
@@ -18,12 +18,14 @@ module Language.PlutusIR (
Datatype (..),
datatypeNameString,
Recursivity (..),
Strictness (..),
Binding (..),
bindingSubterms,
bindingSubtypes,
Term (..),
termSubterms,
termSubtypes,
termBindings,
Program (..)
) where

@@ -35,7 +37,7 @@ import Language.PlutusCore.CBOR ()
import Language.PlutusCore.MkPlc (Def (..), TermLike (..), TyVarDecl (..), VarDecl (..))
import qualified Language.PlutusCore.Pretty as PLC

import Control.Lens
import Control.Lens hiding (Strict)

import Codec.Serialise (Serialise)

@@ -74,7 +76,12 @@ data Recursivity = NonRec | Rec

instance Serialise Recursivity

data Binding tyname name a = TermBind a (VarDecl tyname name a) (Term tyname name a)
data Strictness = NonStrict | Strict
deriving (Show, Eq, Generic)

instance Serialise Strictness

data Binding tyname name a = TermBind a Strictness (VarDecl tyname name a) (Term tyname name a)
| TypeBind a (TyVarDecl tyname a) (Type tyname a)
| DatatypeBind a (Datatype tyname name a)
deriving (Functor, Show, Eq, Generic)
@@ -85,7 +92,7 @@ instance (Serialise a, Serialise (tyname a), Serialise (name a)) => Serialise (B
-- | Get all the direct child 'Term's of the given 'Binding'.
bindingSubterms :: Traversal' (Binding tyname name a) (Term tyname name a)
bindingSubterms f = \case
TermBind x d t -> TermBind x d <$> f t
TermBind x s d t -> TermBind x s d <$> f t
b@TypeBind {} -> pure b
d@DatatypeBind {} -> pure d

@@ -103,7 +110,7 @@ datatypeSubtypes f (Datatype a n vs m cs) = Datatype a n vs m <$> (traverse . va
-- | Get all the direct child 'Type's of the given 'Binding'.
bindingSubtypes :: Traversal' (Binding tyname name a) (Type tyname a)
bindingSubtypes f = \case
TermBind x d t -> TermBind x <$> varDeclSubtypes f d <*> pure t
TermBind x s d t -> TermBind x s <$> varDeclSubtypes f d <*> pure t
DatatypeBind x d -> DatatypeBind x <$> datatypeSubtypes f d
TypeBind a d ty -> TypeBind a d <$> f ty

@@ -163,7 +170,7 @@ instance TermLike (Term tyname name) tyname name where
unwrap = Unwrap
iWrap = IWrap
error = Error
termLet x (Def vd bind) = Let x NonRec [TermBind x vd bind]
termLet x (Def vd bind) = Let x NonRec [TermBind x Strict vd bind]
typeLet x (Def vd bind) = Let x NonRec [TypeBind x vd bind]

{-# INLINE termSubterms #-}
@@ -198,6 +205,13 @@ termSubtypes f = \case
c@Constant {} -> pure c
b@Builtin {} -> pure b

{-# INLINE termBindings #-}
-- | Get all the direct child 'Binding's of the given 'Term'.
termBindings :: Traversal' (Term tyname name a) (Binding tyname name a)
termBindings f = \case
Let x r bs t -> Let x r <$> traverse f bs <*> pure t
t -> pure t

-- no version as PIR is not versioned
data Program tyname name a = Program a (Term tyname name a) deriving Generic

@@ -218,6 +232,11 @@ instance PrettyBy (PLC.PrettyConfigClassic configName) Recursivity where
NonRec -> parens' "nonrec"
Rec -> parens' "rec"

instance PrettyBy (PLC.PrettyConfigClassic configName) Strictness where
prettyBy _ = \case
NonStrict -> parens' "nonstrict"
Strict -> parens' "strict"

instance (PLC.PrettyClassicBy configName (tyname a), PLC.PrettyClassicBy configName (name a)) =>
PrettyBy (PLC.PrettyConfigClassic configName) (Datatype tyname name a) where
prettyBy config (Datatype _ ty tyvars destr constrs) = parens' ("datatype" </> vsep' [
@@ -229,7 +248,7 @@ instance (PLC.PrettyClassicBy configName (tyname a), PLC.PrettyClassicBy configN
instance (PLC.PrettyClassicBy configName (tyname a), PLC.PrettyClassicBy configName (name a)) =>
PrettyBy (PLC.PrettyConfigClassic configName) (Binding tyname name a) where
prettyBy config = \case
TermBind _ d t -> parens' ("termbind" </> vsep' [prettyBy config d, prettyBy config t])
TermBind _ s d t -> parens' ("termbind" </> vsep' [prettyBy config s, prettyBy config d, prettyBy config t])
TypeBind _ d ty -> parens' ("typebind" </> vsep' [prettyBy config d, prettyBy config ty])
DatatypeBind _ d -> parens' ("datatypebind" </> prettyBy config d)

@@ -81,7 +81,7 @@ bindingDeps
=> Binding tyname name a
-> m g
bindingDeps b = case b of
TermBind _ d@(VarDecl _ n _) rhs -> do
TermBind _ _ d@(VarDecl _ n _) rhs -> do
vDeps <- varDeclDeps d
tDeps <- withCurrent n $ termDeps rhs
pure $ G.overlay vDeps tDeps
@@ -23,6 +23,7 @@ import Language.PlutusIR.Compiler.Lower
import Language.PlutusIR.Compiler.Provenance
import Language.PlutusIR.Compiler.Types
import qualified Language.PlutusIR.Optimizer.DeadCode as DeadCode
import qualified Language.PlutusIR.Transform.NonStrict as NonStrict
import Language.PlutusIR.Transform.Rename ()
import qualified Language.PlutusIR.Transform.ThunkRecursions as ThunkRec

@@ -40,7 +41,10 @@ compileTerm :: Compiling m e a => Term TyName Name a -> m (PLCTerm a)
compileTerm =
(pure . original)
>=> simplifyTerm
>=> ThunkRec.thunkRecursionsTerm
>=> (pure . ThunkRec.thunkRecursions)
-- We need globally unique names for compiling non-strict bindings away
>=> PLC.rename
>=> NonStrict.compileNonStrictBindings
>=> Let.compileLets Let.Types
>=> Let.compileLets Let.RecTerms
-- We introduce some non-recursive let bindings while eliminating recursive let-bindings, so we
@@ -14,6 +14,7 @@
-- | Support for generating PIR with global definitions with dependencies between them.
module Language.PlutusIR.Compiler.Definitions (DefT
, MonadDefs (..)
, TermDefWithStrictness
, runDefT
, defineTerm
, defineType
@@ -52,8 +53,10 @@ type DefMap key def = Map.Map key (def, Set.Set key)
mapDefs :: (a -> b) -> DefMap key a -> DefMap key b
mapDefs f = Map.map (\(def, deps) -> (f def, deps))

type TermDefWithStrictness ann = PLC.Def (VarDecl TyName Name ann) (Term TyName Name ann, Strictness)

data DefState key ann = DefState {
_termDefs :: DefMap key (TermDef (Term TyName Name) TyName Name ann),
_termDefs :: DefMap key (TermDefWithStrictness ann),
_typeDefs :: DefMap key (TypeDef TyName ann),
_datatypeDefs :: DefMap key (DatatypeDef TyName Name ann),
_aliases :: Set.Set key
@@ -77,7 +80,7 @@ runDefT x act = do
where
bindingDefs defs =
let
terms = mapDefs (\d -> TermBind x (PLC.defVar d) (PLC.defVal d)) (_termDefs defs)
terms = mapDefs (\d -> TermBind x (snd $ PLC.defVal d) (PLC.defVar d) (fst $ PLC.defVal d)) (_termDefs defs)
types = mapDefs (\d -> TypeBind x (PLC.defVar d) (PLC.defVal d)) (_typeDefs defs)
datatypes = mapDefs (\d -> DatatypeBind x (PLC.defVal d)) (_datatypeDefs defs)
in terms `Map.union` types `Map.union` datatypes
@@ -120,7 +123,7 @@ instance MonadDefs key ann m => MonadDefs key ann (StateT s m)
instance MonadDefs key ann m => MonadDefs key ann (ExceptT e m)
instance MonadDefs key ann m => MonadDefs key ann (ReaderT r m)

defineTerm :: MonadDefs key ann m => key -> TermDef (Term TyName Name) TyName Name ann -> Set.Set key -> m ()
defineTerm :: MonadDefs key ann m => key -> TermDefWithStrictness ann -> Set.Set key -> m ()
defineTerm name def deps = liftDef $ DefT $ modify $ over termDefs $ Map.insert name (def, deps)

defineType :: MonadDefs key ann m => key -> TypeDef TyName ann -> Set.Set key -> m ()
@@ -145,8 +148,8 @@ lookupTerm :: (MonadDefs key ann m) => ann -> key -> m (Maybe (Term TyName Name
lookupTerm x name = do
DefState{_termDefs=ds,_aliases=as} <- liftDef $ DefT get
pure $ case Map.lookup name ds of
Just (def, _) -> Just $ if Set.member name as then PLC.defVal def else mkVar x $ PLC.defVar def
Nothing -> Nothing
Just (def, _) | not (Set.member name as) -> Just $ mkVar x $ PLC.defVar def
_ -> Nothing

lookupConstructors :: (MonadDefs key ann m) => ann -> key -> m (Maybe [Term TyName Name ann])
lookupConstructors x name = do
@@ -15,7 +15,7 @@ import qualified Language.PlutusIR.MkPir as PIR
import Control.Monad
import Control.Monad.Error.Lens

import Control.Lens
import Control.Lens hiding (Strict)

import Data.List

@@ -43,7 +43,7 @@ compileRecBindings kind body bs
compileRecTermBindings :: Compiling m e a => LetKind -> PIRTerm a -> [Binding TyName Name (Provenance a)] -> m (PIRTerm a)
compileRecTermBindings RecTerms body bs = do
binds <- forM bs $ \case
TermBind _ vd rhs -> pure $ PIR.Def vd rhs
TermBind _ Strict vd rhs -> pure $ PIR.Def vd rhs
_ -> getEnclosing >>= \p -> throwing _Error $ CompilationError p "Internal error: type binding in term binding group"
compileRecTerms body binds
compileRecTermBindings _ body bs = getEnclosing >>= \p -> pure $ Let p Rec bs body
@@ -57,7 +57,7 @@ compileRecTypeBindings Types body bs = do
compileRecTypeBindings _ body bs = getEnclosing >>= \p -> pure $ Let p Rec bs body

compileNonRecBinding :: Compiling m e a => LetKind -> PIRTerm a -> Binding TyName Name (Provenance a) -> m (PIRTerm a)
compileNonRecBinding NonRecTerms body (TermBind x d rhs) = withEnclosing (const $ TermBinding (varDeclNameString d) x) $
compileNonRecBinding NonRecTerms body (TermBind x Strict d rhs) = withEnclosing (const $ TermBinding (varDeclNameString d) x) $
PIR.mkImmediateLamAbs <$> getEnclosing <*> pure (PIR.Def d rhs) <*> pure body
compileNonRecBinding Types body (TypeBind x d rhs) = withEnclosing (const $ TypeBinding (tyVarDeclNameString d) x) $
PIR.mkImmediateTyAbs <$> getEnclosing <*> pure (PIR.Def d rhs) <*> pure body
@@ -74,6 +74,6 @@ mkFixpoint bs = do
funs <- forM bs $ \(PIR.Def (PIR.VarDecl p name ty) term) ->
case PIR.mkFunctionDef p name ty term of
Just fun -> pure fun
Nothing -> throwing _Error $ CompilationError (PLC.tyLoc ty) "Recursive values must be of function type. You may need to manually add unit arguments."
Nothing -> throwing _Error $ CompilationError (PLC.tyLoc ty) "Recursive values must be of function type"

liftQuote $ Function.getMutualFixOf p0 funs
@@ -42,6 +42,9 @@ genTyName = TyName <$> genName
genRecursivity :: MonadGen m => m Recursivity
genRecursivity = Gen.element [Rec, NonRec]

genStrictness :: MonadGen m => m Strictness
genStrictness = Gen.element [Strict, NonStrict]

genVarDecl :: MonadGen m => m (VarDecl TyName Name ())
genVarDecl = VarDecl () <$> genName <*> genType

@@ -54,7 +57,7 @@ genDatatype = Datatype () <$> genTyVarDecl <*> listOf genTyVarDecl <*> genName <

genBinding :: MonadGen m => m (Binding TyName Name ())
genBinding = Gen.choice [genTermBind, genTypeBind, genDatatypeBind]
where genTermBind = TermBind () <$> genVarDecl <*> genTerm
where genTermBind = TermBind () <$> genStrictness <*> genVarDecl <*> genTerm
genTypeBind = TypeBind () <$> genTyVarDecl <*> genType
genDatatypeBind = DatatypeBind () <$> genDatatype

@@ -58,7 +58,7 @@ liveBinding =
liveVarDecl (VarDecl _ n _) = live n
liveTyVarDecl (TyVarDecl _ n _) = live n
in \case
TermBind _ d _ -> liveVarDecl d
TermBind _ _ d _ -> liveVarDecl d
TypeBind _ d _ -> liveTyVarDecl d
DatatypeBind _ (Datatype _ d _ destr constrs) -> or <$> (sequence $ [liveTyVarDecl d, live destr] ++ fmap liveVarDecl constrs)

@@ -139,6 +139,8 @@ reservedWords =
, "let"
, "nonrec"
, "rec"
, "nonstrict"
, "strict"
, "termbind"
, "typebind"
, "datatypebind"
@@ -216,6 +218,9 @@ constant = do
recursivity :: Parser Recursivity
recursivity = inParens $ (reservedWord "rec" >> return Rec) <|> (reservedWord "nonrec" >> return NonRec)

strictness :: Parser Strictness
strictness = inParens $ (reservedWord "strict" >> return Strict) <|> (reservedWord "nonstrict" >> return NonStrict)

funType :: Parser (Type TyName SourcePos)
funType = TyFun <$> reservedWord "fun" <*> typ <*> typ

@@ -268,7 +273,7 @@ datatype = inParens $ Datatype <$> reservedWord "datatype"

binding :: Parser (Binding TyName Name SourcePos)
binding = inParens $
(try $ reservedWord "termbind" >> TermBind <$> getSourcePos <*> varDecl <*> term)
(try $ reservedWord "termbind" >> TermBind <$> getSourcePos <*> strictness <*> varDecl <*> term)
<|> (reservedWord "typebind" >> TypeBind <$> getSourcePos <*> tyVarDecl <*> typ)
<|> (reservedWord "datatypebind" >> DatatypeBind <$> getSourcePos <*> datatype)

@@ -0,0 +1,59 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Compile non-strict bindings into strict bindings.
module Language.PlutusIR.Transform.NonStrict (compileNonStrictBindings) where

import Language.PlutusIR
import Language.PlutusIR.Transform.Rename ()
import Language.PlutusIR.Transform.Substitute

import Language.PlutusCore.Quote
import qualified Language.PlutusCore.StdLib.Data.Unit as Unit

import Control.Lens hiding (Strict)
import Control.Monad.State

import qualified Data.Map as Map

{- Note [Compiling non-strict bindings]
Given `let x : ty = rhs in body`, we
- Replace `let x : ty = rhs in ...` with `let x : () -> ty = \arg : () -> rhs in ...`
- Replace all references to `x` in `body` with `x ()`
To avoid quadratic behaviour, we do the latter substitution in one go, by collecting
all the substitutions to do as we go, and then doing them in one go at the end.
Since we are constructing a global substitution, so we need globally unique
names to avoid clashes.
-}

type Substs a = Map.Map (Name a) (Term TyName Name a)

-- | Compile all the non-strict bindings in a term into strict bindings. Note: requires globally
-- unique names.
compileNonStrictBindings :: MonadQuote m => Term TyName Name a -> m (Term TyName Name a)
compileNonStrictBindings t = do
(t', substs) <- liftQuote $ flip runStateT mempty $ strictifyTerm t
-- See Note [Compiling non-strict bindings]
pure $ termSubstNames (\n -> Map.lookup n substs) t'

strictifyTerm :: (MonadState (Substs a) m, MonadQuote m) => Term TyName Name a -> m (Term TyName Name a)
strictifyTerm = transformMOf termSubterms (traverseOf termBindings strictifyBinding)

strictifyBinding :: (MonadState (Substs a) m, MonadQuote m) => Binding TyName Name a -> m (Binding TyName Name a)
strictifyBinding = \case
TermBind x NonStrict (VarDecl x' name ty) rhs -> do
let ann = x

argName <- liftQuote $ freshName ann "arg"
-- TODO: These are created at every use site, we should bind them globally
let unit = ann <$ Unit.unit
unitval = ann <$ Unit.unitval
forced = Apply ann (Var ann name) unitval

-- See Note [Compiling non-strict bindings]
modify $ Map.insert name forced

pure $ TermBind x Strict (VarDecl x' name (TyFun ann unit ty)) (LamAbs ann argName unit rhs)
x -> pure x
@@ -78,11 +78,11 @@ renameBindingCM
=> Binding tyname name ann
-> ContT c PLC.ScopedRenameM (PLC.ScopedRenameM (Binding tyname name ann))
renameBindingCM = \case
TermBind x var term -> do
TermBind x s var term -> do
-- The first stage.
varRen <- ContT $ PLC.withFreshenedVarDecl var
-- The second stage (the type of the variable and the RHS get renamed).
pure $ TermBind x <$> varRen <*> renameTermM term
pure $ TermBind x s <$> varRen <*> renameTermM term
TypeBind x var ty -> do
-- The First stage.
varFr <- ContT $ PLC.withFreshenedTyVarDecl var
@@ -114,9 +114,9 @@ renameTermM
:: (PLC.HasUnique (tyname ann) PLC.TypeUnique, PLC.HasUnique (name ann) PLC.TermUnique)
=> Term tyname name ann -> PLC.ScopedRenameM (Term tyname name ann)
renameTermM = \case
Let x recy binds term ->
withFreshenedBindings recy binds $ \bindsFr ->
Let x recy bindsFr <$> renameTermM term
Let x r binds term ->
withFreshenedBindings r binds $ \bindsFr ->
Let x r bindsFr <$> renameTermM term
Var x name ->
Var x <$> PLC.renameNameM name
TyAbs x name kind body ->

0 comments on commit 183d156

Please sign in to comment.
You can’t perform that action at this time.