Copyright | (C) 2020-2022 QBayLogic B.V. |
---|---|
License | BSD2 (see the file LICENSE) |
Maintainer | QBayLogic B.V. <devops@qbaylogic.com> |
Safe Haskell | None |
Language | Haskell2010 |
Types for the Partial Evaluator
Synopsis
- whnf' :: Evaluator -> BindingMap -> VarEnv Term -> TyConMap -> PrimHeap -> Supply -> InScopeSet -> Bool -> Term -> (PrimHeap, PureHeap, Term)
- whnf :: Evaluator -> TyConMap -> Bool -> Machine -> Machine
- data Evaluator = Evaluator {
- step :: Step
- unwind :: Unwind
- primStep :: PrimStep
- primUnwind :: PrimUnwind
- unwindStack :: Machine -> Maybe Machine
- type Step = Machine -> TyConMap -> Maybe Machine
- type Unwind = Value -> Step
- type PrimStep = TyConMap -> Bool -> PrimInfo -> [Type] -> [Value] -> Machine -> Maybe Machine
- type PrimUnwind = TyConMap -> PrimInfo -> [Type] -> [Value] -> Value -> [Term] -> Machine -> Maybe Machine
- data Machine = Machine {
- mHeapPrim :: PrimHeap
- mHeapGlobal :: PureHeap
- mHeapLocal :: PureHeap
- mStack :: Stack
- mSupply :: Supply
- mScopeNames :: InScopeSet
- mTerm :: Term
- type PrimHeap = (IntMap Term, Int)
- type PureHeap = VarEnv Term
- type Stack = [StackFrame]
- data StackFrame
- data Value
- valToTerm :: Value -> Term
- collectValueTicks :: Value -> (Value, [TickInfo])
- forcePrims :: Machine -> Bool
- primCount :: Machine -> Int
- primLookup :: Int -> Machine -> Maybe Term
- primInsert :: Int -> Term -> Machine -> Machine
- primUpdate :: Int -> Term -> Machine -> Machine
- heapLookup :: IdScope -> Id -> Machine -> Maybe Term
- heapContains :: IdScope -> Id -> Machine -> Bool
- heapInsert :: IdScope -> Id -> Term -> Machine -> Machine
- heapDelete :: IdScope -> Id -> Machine -> Machine
- stackPush :: StackFrame -> Machine -> Machine
- stackPop :: Machine -> Maybe (Machine, StackFrame)
- stackClear :: Machine -> Machine
- stackNull :: Machine -> Bool
- getTerm :: Machine -> Term
- setTerm :: Term -> Machine -> Machine
Documentation
whnf' :: Evaluator -> BindingMap -> VarEnv Term -> TyConMap -> PrimHeap -> Supply -> InScopeSet -> Bool -> Term -> (PrimHeap, PureHeap, Term) Source #
whnf :: Evaluator -> TyConMap -> Bool -> Machine -> Machine Source #
Evaluate to WHNF given an existing Heap and Stack
An evaluator is a collection of basic building blocks which are used to define partial evaluation. In this implementation, it consists of two types of function:
- steps, which applies the reduction realtion to the current term
- unwindings, which pop the stack and evaluate the stack frame
Variants of these functions also exist for evalauting primitive operations. This is because there may be multiple frontends to the compiler which can reuse a common step and unwind, but have different primitives.
Evaluator | |
|
unwindStack :: Machine -> Maybe Machine Source #
Completely unwind the stack to get back the complete term
type Step = Machine -> TyConMap -> Maybe Machine Source #
A single step in the partial evaluator. The result is the new heap and stack, and the next expression to be reduced.
type PrimStep = TyConMap -> Bool -> PrimInfo -> [Type] -> [Value] -> Machine -> Maybe Machine Source #
type PrimUnwind = TyConMap -> PrimInfo -> [Type] -> [Value] -> Value -> [Term] -> Machine -> Maybe Machine Source #
A machine represents the current state of the abstract machine used to evaluate terms. A machine has a term under evaluation, a stack, and three heaps:
- a primitive heap to store IO values from primitives (like ByteArrays)
- a global heap to store top-level bindings in scope
- a local heap to store local bindings in scope
Machines also include a unique supply and InScopeSet. These are needed when new heap bindings are created, and are just an implementation detail.
Machine | |
|
type Stack = [StackFrame] Source #
data StackFrame Source #
Update IdScope Id | |
Apply Id | |
Instantiate Type | |
PrimApply PrimInfo [Type] [Value] [Term] | |
Scrutinise Type [Alt] | |
Tickish TickInfo |
Instances
Show StackFrame Source # | |
Defined in Clash.Core.Evaluator.Types showsPrec :: Int -> StackFrame -> ShowS # show :: StackFrame -> String # showList :: [StackFrame] -> ShowS # | |
ClashPretty StackFrame Source # | |
Defined in Clash.Core.Evaluator.Types clashPretty :: StackFrame -> Doc () Source # |
Lambda Id Term | Functions |
TyLambda TyVar Term | Type abstractions |
DC DataCon [Either Term Type] | Data constructors |
Lit Literal | Literals |
PrimVal PrimInfo [Type] [Value] | Clash's number types are represented by their "fromInteger#" primitive function. So some primitives are values. |
Suspend Term | Used by lazy primitives |
TickValue TickInfo Value | Preserve ticks from Terms in Values |
CastValue Value Type Type | Preserve casts from Terms in Values |
forcePrims :: Machine -> Bool Source #
Are we in a context where special primitives must be forced.
See [Note: forcing special primitives]
stackClear :: Machine -> Machine Source #