clash-lib-0.9999: CAES Language for Synchronous Hardware - As a Library
Copyright(C) 2012-2016 University of Twente
2016 Myrtle Software Ltd
2017 Google Inc.
LicenseBSD2 (see the file LICENSE)
MaintainerChristiaan Baaij <christiaan.baaij@gmail.com>
Safe HaskellNone
LanguageHaskell2010

Clash.Rewrite.Util

Description

Utilities for rewriting: e.g. inlining, specialisation, etc.

Synopsis

Documentation

zoomExtra :: State extra a -> RewriteMonad extra a Source #

Lift an action working in the _extra state to the RewriteMonad

findAccidentialShadows :: Term -> [[Id]] Source #

Some transformations might erroneously introduce shadowing. For example, a transformation might result in:

let a = ... b = ... a = ...

where the last a, shadows the first, while Clash assumes that this can't happen. This function finds those constructs and a list of found duplicates.

apply Source #

Arguments

:: String

Name of the transformation

-> Rewrite extra

Transformation to be applied

-> Rewrite extra 

Record if a transformation is successfully applied

applyDebug Source #

Arguments

:: DebugLevel

The current debugging level

-> String

Name of the transformation

-> Term

Original expression

-> Bool

Whether the rewrite indicated change

-> Term

New expression

-> RewriteMonad extra Term 

runRewrite Source #

Arguments

:: String

Name of the transformation

-> InScopeSet 
-> Rewrite extra

Transformation to perform

-> Term

Term to transform

-> RewriteMonad extra Term 

Perform a transformation on a Term

runRewriteSession :: RewriteEnv -> RewriteState extra -> RewriteMonad extra a -> a Source #

Evaluate a RewriteSession to its inner monad.

setChanged :: RewriteMonad extra () Source #

Notify that a transformation has changed the expression

changed :: a -> RewriteMonad extra a Source #

Identity function that additionally notifies that a transformation has changed the expression

mkTmBinderFor Source #

Arguments

:: (Monad m, MonadUnique m, MonadFail m) 
=> InScopeSet 
-> TyConMap

TyCon cache

-> Name a

Name of the new binder

-> Term

Term to bind

-> m Id 

Make a new binder and variable reference for a term

mkBinderFor Source #

Arguments

:: (Monad m, MonadUnique m, MonadFail m) 
=> InScopeSet 
-> TyConMap

TyCon cache

-> Name a

Name of the new binder

-> Either Term Type

Type or Term to bind

-> m (Either Id TyVar) 

Make a new binder and variable reference for either a term or a type

mkInternalVar Source #

Arguments

:: (Monad m, MonadUnique m) 
=> InScopeSet 
-> OccName

Name of the identifier

-> KindOrType 
-> m Id 

Make a new, unique, identifier

inlineBinders Source #

Arguments

:: (Term -> LetBinding -> RewriteMonad extra Bool)

Property test

-> Rewrite extra 

Inline the binders in a let-binding that have a certain property

isJoinPointIn Source #

Arguments

:: Id

Id of the local binder

-> Term

Expression in which the binder is bound

-> Bool 

Determine whether a binder is a join-point created for a complex case expression.

A join-point is when a local function only occurs in tail-call positions, and when it does, more than once.

tailCalls Source #

Arguments

:: Id

Function to check

-> Term

Expression to check it in

-> Maybe Int 

Count the number of (only) tail calls of a function in an expression. Nothing indicates that the function was used in a non-tail call position.

isVoidWrapper :: Term -> Bool Source #

Determines whether a function has the following shape:

\(w :: Void) -> f a b c

i.e. is a wrapper around a (partially) applied function f, where the introduced argument w is not used by f

substituteBinders Source #

Arguments

:: InScopeSet 
-> [LetBinding]

Let-binders to substitute

-> [LetBinding]

Let-binders where substitution takes place

-> Term

Expression where substitution takes place

-> ([LetBinding], Term) 

Substitute the RHS of the first set of Let-binders for references to the first set of Let-binders in: the second set of Let-binders and the additional term

isWorkFree :: Term -> Bool Source #

Determine whether a term does any work, i.e. adds to the size of the circuit

isConstant :: Term -> Bool Source #

Determine if a term represents a constant

inlineOrLiftBinders Source #

Arguments

:: (LetBinding -> RewriteMonad extra Bool)

Property test

-> (Term -> LetBinding -> RewriteMonad extra Bool)

Test whether to lift or inline

  • True: inline
  • False: lift
-> Rewrite extra 

liftBinding :: LetBinding -> RewriteMonad extra LetBinding Source #

Create a global function for a Let-binding and return a Let-binding where the RHS is a reference to the new global function applied to the free variables of the original RHS

mkFunction Source #

Arguments

:: TmName

Name of the function

-> SrcSpan 
-> InlineSpec 
-> Term

Term bound to the function

-> RewriteMonad extra Id

Name with a proper unique and the type of the function

Make a global function for a name-term tuple

addGlobalBind :: TmName -> Type -> SrcSpan -> InlineSpec -> Term -> RewriteMonad extra () Source #

Add a function to the set of global binders

cloneName :: (Monad m, MonadUnique m) => Name a -> m (Name a) Source #

Create a new name out of the given name, but with another unique

isUntranslatable Source #

Arguments

:: Bool

String representable

-> Term 
-> RewriteMonad extra Bool 

Determine if a term cannot be represented in hardware

isUntranslatableType Source #

Arguments

:: Bool

String representable

-> Type 
-> RewriteMonad extra Bool 

Determine if a type cannot be represented in hardware

mkWildValBinder :: (Monad m, MonadUnique m) => InScopeSet -> Type -> m Id Source #

Make a binder that should not be referenced

mkSelectorCase Source #

Arguments

:: HasCallStack 
=> (Functor m, Monad m, MonadUnique m) 
=> String

Name of the caller of this function

-> InScopeSet 
-> TyConMap

TyCon cache

-> Term

Subject of the case-composition

-> Int 
-> Int 
-> m Term 

Make a case-decomposition that extracts a field out of a (Sum-of-)Product type

specialise Source #

Arguments

:: Lens' extra (Map (Id, Int, Either Term Type) Id)

Lens into previous specialisations

-> Lens' extra (VarEnv Int)

Lens into the specialisation history

-> Lens' extra Int

Lens into the specialisation limit

-> Rewrite extra 

Specialise an application on its argument

specialise' Source #

Arguments

:: Lens' extra (Map (Id, Int, Either Term Type) Id)

Lens into previous specialisations

-> Lens' extra (VarEnv Int)

Lens into specialisation history

-> Lens' extra Int

Lens into the specialisation limit

-> TransformContext 
-> Term

Original term

-> (Term, [Either Term Type], [TickInfo])

Function part of the term, split into root and applied arguments

-> Either Term Type

Argument to specialize on

-> RewriteMonad extra Term 

Specialise an application on its argument

specArgBndrsAndVars :: Either Term Type -> ([Either Id TyVar], [Either Term Type]) Source #

Create binders and variable references for free variables in specArg