parsley-core-2.3.0.0: A fast parser combinator library backed by Typed Template Haskell
LicenseBSD-3-Clause
MaintainerJamie Willis
Stabilityexperimental
Safe HaskellSafe-Inferred
LanguageHaskell2010

Parsley.Internal.Backend.Machine.Types.Context

Description

This module contains the compile-time state of a parser, which is used to aid code generation.

Since: 1.4.0.0

Synopsis

Core Data-types

data Ctx s o a Source #

The Ctx stores information that aids or facilitates the generation of parser code, but its components are fully static and do not materialise as runtime values, but may form part of the generated code.

Since: 1.0.0.0

data QJoin s o a x Source #

QJoin represents Φ-nodes in the generated parser, and is represented as a StaCont.

Since: 1.0.0.0

emptyCtx :: DMap MVar (QSubroutine s o a) -> Ctx s o a Source #

Creates an empty Ctx populated with a map of the top-level (recursive) bindings: information about their required free-registers is included.

Since: 1.0.0.0

Subroutines

Subroutines are the representations of let-bindings or recursive parsers in the original user program. They are factored out to prevent code-explosion.

The names of these bindings are helpfully stored within the Ctx and can be accessed statically. While the initial context is always populated with the top-level recursive bindings, additional bindings can be added "dynamically" during evaluation, for instance iterative bindings and recursive bindings that capture their free-registers.

insertSub Source #

Arguments

:: MVar x

The name of the binding.

-> StaSubroutine s o a x

The binding to register.

-> Ctx s o a

The current context.

-> Ctx s o a

The new context.

Registers a new subroutine into the context, which will be available according to "local" Reader semantics.

Since: 1.2.0.0

askSub :: MonadReader (Ctx s o a) m => MVar x -> m (StaSubroutine s o a x) Source #

Fetches a binding from the context according to its name (See MVar). In the (hopefully impossible!) event that it is not found in the map, will throw a MissingDependency exception. If this binding had free registers, these are generously provided by the Ctx.

Since: 1.2.0.0

Join Points

Similar to the subroutines, join points (or Φ-nodes) are used by the parsley engine to factor out common branches of code. When generated, access to these bindings is available via the Ctx.

insertΦ Source #

Arguments

:: ΦVar x

The name of the new binding.

-> StaCont s o a x

The binding to add.

-> Ctx s o a

The old context.

-> Ctx s o a

The new context.

Registers a new binding into the Ctx so that it can be retrieved later. Binding expires according to "local" Reader semantics.

Since: 1.0.0.0

askΦ :: MonadReader (Ctx s o a) m => ΦVar x -> m (StaCont s o a x) Source #

Fetches a binding from the Ctx.

Since: 1.2.0.0

Registers

Registers are used within parsley to persist state across different parts of a parser. Across recursion and call-boundaries, these materialise as STRefs. These are stored in the Ctx and can be looked up when required.

However, parsley does not mandate that registers must exist in this form. Registers can be subject to caching, where a register's static "most-recently known" may be stored within the Ctx in addition to the "true" binding. This can, in effect, mean that registers do not exist at runtime. Both forms of register data can be extracted, however exceptions will guard against mis-management.

Putters

insertNewΣ Source #

Arguments

:: ΣVar x

The name of the register.

-> Maybe (Code (STRef s x))

The runtime representation, if available.

-> Defunc x

The initial value stored into the register.

-> Ctx s o a

The old context.

-> Ctx s o a

The new context.

Registers a recently created register into the Ctx. This must be provided with the original value in the register, which is injected into the cache.

Since: 1.0.0.0

cacheΣ :: ΣVar x -> Defunc x -> Ctx s o a -> Ctx s o a Source #

Updated the "last-known value" of a register in the cache.

Since: 1.0.0.0

Getters

concreteΣ :: ΣVar x -> Ctx s o a -> Code (STRef s x) Source #

Fetches a known to be concrete register (i.e. one that must be materialised at runtime as an STRef). If this register does not exist, this throws an IntangibleRegister exception.

Since: 1.0.0.0

cachedΣ :: ΣVar x -> Ctx s o a -> Defunc x Source #

Fetches the cached "last-known value" of a register. If the cache is unaware of this value, a RegisterFault exception is thrown.

Since: 1.0.0.0

takeFreeRegisters Source #

Arguments

:: Regs rs

The free registers demanded by the binding.

-> Ctx s o a

The old context.

-> (Ctx s o a -> DynSubroutine s o a x)

Given the new context, function that produces the subroutine.

-> DynFunc rs s o a x

The newly produced dynamic function.

When a binding is generated, it needs to generate function arguments for each of the free registers it requires. This is performed by this function, which also adds each of these freshly bound registers into the Ctx. Has the effect of converting a DynSubroutine into a DynFunc.

Since: 1.2.0.0

Debug Level Tracking

The debug combinator generates runtime diagnostic information. To make this more ergonomic, it would be nice to indent nested debug info. To do this perfectly, a debug level that controls indentation would need to be added to Γ. This is problematic since, without a lot of work and complexity, it would introduce a runtime penalty for not just debug parsers, but all other parsers too. As a compromise, the debug level is stored purely statically in the Ctx: the consequence is that the indentation level resets across a call-boundary.

debugUp :: Ctx s o a -> Ctx s o a Source #

Increase the debug level for the forseeable static future.

Since: 1.0.0.0

debugDown :: Ctx s o a -> Ctx s o a Source #

Decrease the debug level for the forseeable static future.

Since: 1.0.0.0

debugLevel :: Ctx s o a -> Int Source #

Approximate depth of debug combinator.

Unique Offsets

The Offset type refines dynamic offsets with statically known properties such as input consumed and the source of the offset. These sources are unique and must be generated statically, with "local" Reader semantics. This means that the Ctx lends itself nicely to managing the pool of fresh offset names.

freshUnique :: MonadReader (Ctx s o a) m => (Word -> m b) -> m b Source #

Generate a fresh name that is valid for the scope of the provided continuation.

Since: 1.4.0.0

nextUnique :: Ctx s o a -> Ctx s o a Source #

Advances the unique identifier stored in the Ctx. This is used to skip a given name.

Since: 1.4.0.0

Token Credit System (Piggy-banks)

Parsley has analysis in place to factor out length checks when it is statically known that n tokens must be consumed in order for a parser to succeed. Part of this analysis is the cut analysis performed in the frontend, and then the coins analysis in the backend during code generation. The meta instructions that reference "coins" interact with a system during interpretation called the "Piggy-bank" system: this is all stored and accessed via the Ctx.

The system works like this:

  • The Ctx stores two components: some coins and some piggybanks.
  • When there are coins present in the Ctx, these can be "spent" to read a token without emitting a length check for it (the guarantee is that a length check was generated to get hold of those coins).
  • When the coins run out a piggy-bank can be broken to get more coins: this should generate a length check for value of the coins in the bank
  • When all the piggy-banks are exhausted, a length check must be generated for each token that is consumed.
  • When adding coins into the system, if the Ctx is bankrupt, then the coins are added immediately along with a length check, otherwise a piggy-bank is added.

These are the basic principles behind this system, and it works effectively. There are some extra edge-case operations that are described in their corresponding documentation. The reason why piggy-banks are stored in the context and not consumed immediately to add to the coin count is so that length checks are delayed to the last possible moment: you should have used all of your current allocation before asking for more!

In addition to this above system, Parsley stores previously read characters in a rewind queue: this means that when backtracking is performed (i.e. when looking ahead) the characters can be statically rewound and made available for free.

Modifiers

storePiggy :: Coins -> Ctx s o a -> Ctx s o a Source #

Place a piggy-bank into the reserve, delaying the corresponding length check until it is broken.

Since: 1.5.0.0

breakPiggy :: Ctx s o a -> (Coins, Ctx s o a) Source #

Break the next piggy-bank in the queue, and fill the coins in return.

Note: This should generate a length check when used!

Since: 1.0.0.0

spendCoin :: Ctx s o a -> Ctx s o a Source #

Spend a single coin, used when a token is consumed.

Since: 1.0.0.0

giveCoins :: Int -> Ctx s o a -> Ctx s o a Source #

Adds coins into the current supply.

Since: 1.5.0.0

refundCoins :: Int -> Ctx s o a -> Ctx s o a Source #

Adds coins into the current supply.

Since: 1.5.0.0

voidCoins :: Ctx s o a -> Ctx s o a Source #

Removes all coins and piggy-banks, such that isBankrupt == True.

Since: 1.0.0.0

Getters

coins :: Ctx s o a -> Int Source #

Number of tokens free to consume without length check.

hasCoin :: Ctx s o a -> Bool Source #

Does the context have coins available?

Since: 1.0.0.0

isBankrupt :: Ctx s o a -> Bool Source #

Is it the case that there are no coins and no piggy-banks remaining?

Since: 1.0.0.0

canAfford :: Int -> Ctx s o a -> Maybe Int Source #

Asks if the current coin total can afford a charge of \(n\) characters.

This is used by DrainCoins, which will have to emit a full length check of size \(n\) if this quota cannot be reached.

Since: 1.5.0.0

netWorth :: Ctx s o a -> Int Source #

The sum of the coins and piggies

Input Reclamation

addChar :: CharPred -> Code Char -> Offset o -> Ctx s o a -> Ctx s o a Source #

Caches a known character and the next offset into the context so that it can be retrieved later.

Since: 1.5.0.0

readChar Source #

Arguments

:: Ctx s o a

The original context.

-> CharPred

The predicate that this character will be tested against

-> ((Code Char -> Offset o -> Code b) -> Code b)

The fallback source of input.

-> (Code Char -> CharPred -> CharPred -> Offset o -> Ctx s o a -> Code b)

The continuation that needs the read characters and updated context.

-> Code b 

Reads a character from the context's retrieval queue if one exists. If not, reads a character from another given source (and adds it to the rewind buffer).

Since: 2.1.0.0