funcons-tools-0.2.0.11: A modular interpreter for executing funcons
Safe HaskellNone
LanguageHaskell2010

Funcons.EDSL

Description

This module provides the types and the functions necessary for defining funcons. The package provides a large collection of predefined funcons in Funcons.Core. Module Funcons.Tools provides functions for creating executables.

Synopsis

Funcon representation

data Funcons Source #

Internal representation of funcon terms. The generic constructors FName and FApp use names to represent nullary funcons and applications of funcons to other terms. Funcon terms are easily created using applyFuncon or via the smart constructors exported by Funcons.Core.

Instances

Instances details
Eq Funcons Source # 
Instance details

Defined in Funcons.Types

Methods

(==) :: Funcons -> Funcons -> Bool #

(/=) :: Funcons -> Funcons -> Bool #

Ord Funcons Source # 
Instance details

Defined in Funcons.Types

Read Funcons Source # 
Instance details

Defined in Funcons.Types

Show Funcons Source # 
Instance details

Defined in Funcons.Types

HasValues Funcons Source # 
Instance details

Defined in Funcons.Types

type ComputationTypes = ComputationTypes Funcons Source #

Representation of builtin types.

data SeqSortOp #

Postfix operators for specifying sequences.

Constructors

StarOp 
PlusOp 
QuestionMarkOp 

applyFuncon :: Name -> [Funcons] -> Funcons Source #

Build funcon terms by applying a funcon name to `zero or more' funcon terms. This function is useful for defining smart constructors, e,g,

handle_thrown_ :: [Funcons] -> Funcons
handle_thrown_ = applyFuncon "handle-thrown"

or alternatively,

handle_thrown_ :: Funcons -> Funcons -> Funcons
handle_thrown_ x y = applyFuncon "handle-thrown" [x,y]

Smart construction of funcon terms

Funcon terms

set_ :: [Funcons] -> Funcons Source #

Creates a set of funcon terms.

env_fromlist_ :: [(String, Funcons)] -> Funcons Source #

Create an environment from a list of bindings (String to Values) This function has been introduced for easy expression of the semantics of builtin identifiers

Values

int_ :: Int -> Funcons Source #

Creates an integer literal.

nat_ :: Int -> Funcons Source #

Creates a natural literal.

string_ :: String -> Funcons Source #

Creates a string literal.

atom_ :: String -> Funcons Source #

Creates an atom from a String.

Types

type_ :: Types -> Funcons Source #

Creates a tuple of funcon terms. tuple_ :: [Funcons] -> Funcons tuple_ = FTuple

Pretty-print funcon terms

showValues :: Values -> String Source #

Pretty-print a Values.

showValuesSeq :: [Values] -> String Source #

Pretty-print a sequence of Values.

showFuncons :: Funcons -> String Source #

Pretty-print a Funcons.

showFunconsSeq :: [Funcons] -> String Source #

Pretty-print a sequence of Funcons.

showTypes :: Types -> String Source #

Pretty-print a Types.

Is a funcon term a certain value?

isTup :: p -> Bool Source #

Up and downcasting between funcon terms

downcastType :: Funcons -> Types Source #

Returns the unicode representation of an assci value. Otherwise it returns the original value.

Attempt to downcast a funcon term to a value.

upcastNaturals :: Values t -> Values t #

Returns the natural representation of a value if it is a subtype. Otherwise it returns the original value.

upcastIntegers :: Values t -> Values t #

Returns the integer representation of a value if it is a subtype. Otherwise it returns the original value.

upcastRationals :: Values t -> Values t #

Returns the rational representation of a value if it is a subtype. Otherwise it returns the original value.

Evaluation functions

data EvalFunction Source #

Evaluation functions capture the operational behaviour of a funcon. Evaluation functions come in multiple flavours, each with a different treatment of the arguments of the funcon. Before the application of an evaluation funcon, any argument may be evaluated, depending on the Strictness of the argument.

Constructors

NonStrictFuncon NonStrictFuncon

Funcons for which arguments are not evaluated.

StrictFuncon StrictFuncon

Strict funcons whose arguments are evaluated.

PartiallyStrictFuncon [Strictness] Strictness NonStrictFuncon

Funcons for which some arguments are evaluated.

ValueOp ValueOp

Synonym for StrictFuncon, for value operations.

NullaryFuncon NullaryFuncon

Funcons without any arguments.

data Strictness Source #

Denotes whether an argument of a funcon should be evaluated or not.

Constructors

Strict 
NonStrict 

type StrictFuncon = [Values] -> Rewrite Rewritten Source #

Type synonym for the evaluation function of strict funcons. The evaluation function of a StrictFuncon receives fully evaluated arguments.

type PartiallyStrictFuncon = NonStrictFuncon Source #

Type synonym for the evaluation function of non-strict funcons.

type NonStrictFuncon = [Funcons] -> Rewrite Rewritten Source #

Type synonym for the evaluation function of fully non-strict funcons.

type ValueOp = StrictFuncon Source #

Type synonym for value operations.

type NullaryFuncon = Rewrite Rewritten Source #

Type synonym for the evaluation functions of nullary funcons.

Funcon libraries

type FunconLibrary = Map Name EvalFunction Source #

A funcon library maps funcon names to their evaluation functions.

libOverrides :: [FunconLibrary] -> FunconLibrary Source #

Right-based union of list of FunconLibrarys

libFromList :: [(Name, EvalFunction)] -> FunconLibrary Source #

Creates a FunconLibrary from a list.

library :: FunconLibrary Source #

A funcon library with funcons for builtin types.

Implicit & modular propagation of entities

data MSOS a Source #

Monadic type for the propagation of semantic entities and meta-information on the evaluation of funcons. The meta-information includes a library of funcons (see FunconLibrary), a typing environment (see TypeRelation), runtime options, etc.

The semantic entities are divided into five classes:

  • inherited entities, propagated similar to values of a reader monad.
  • mutable entities, propagated similar to values of a state monad.
  • output entities, propagation similar to values of a write monad.
  • control entities, similar to output entities except only a single control signal can be emitted at once (signals do not form a monoid).
  • input entities, propagated like values of a state monad, but access like value of a reader monad. This package provides simulated input/outout and real interaction via the IO monad. See Funcons.Tools.

For each entity class a map is propagated, mapping entity names to values. This enables modular access to the entities.

Instances

Instances details
Monad MSOS Source # 
Instance details

Defined in Funcons.MSOS

Methods

(>>=) :: MSOS a -> (a -> MSOS b) -> MSOS b #

(>>) :: MSOS a -> MSOS b -> MSOS b #

return :: a -> MSOS a #

Functor MSOS Source # 
Instance details

Defined in Funcons.MSOS

Methods

fmap :: (a -> b) -> MSOS a -> MSOS b #

(<$) :: a -> MSOS b -> MSOS a #

MonadFail MSOS Source # 
Instance details

Defined in Funcons.MSOS

Methods

fail :: String -> MSOS a #

Applicative MSOS Source # 
Instance details

Defined in Funcons.MSOS

Methods

pure :: a -> MSOS a #

(<*>) :: MSOS (a -> b) -> MSOS a -> MSOS b #

liftA2 :: (a -> b -> c) -> MSOS a -> MSOS b -> MSOS c #

(*>) :: MSOS a -> MSOS b -> MSOS b #

(<*) :: MSOS a -> MSOS b -> MSOS a #

data Rewrite a Source #

Monadic type for the implicit propagation of meta-information on the evaluation of funcon terms (no semantic entities). It is separated from MSOS to ensure that side-effects (access or modification of semantic entities) can not occur during syntactic rewrites.

Instances

Instances details
Monad Rewrite Source # 
Instance details

Defined in Funcons.MSOS

Methods

(>>=) :: Rewrite a -> (a -> Rewrite b) -> Rewrite b #

(>>) :: Rewrite a -> Rewrite b -> Rewrite b #

return :: a -> Rewrite a #

Functor Rewrite Source # 
Instance details

Defined in Funcons.MSOS

Methods

fmap :: (a -> b) -> Rewrite a -> Rewrite b #

(<$) :: a -> Rewrite b -> Rewrite a #

Applicative Rewrite Source # 
Instance details

Defined in Funcons.MSOS

Methods

pure :: a -> Rewrite a #

(<*>) :: Rewrite (a -> b) -> Rewrite a -> Rewrite b #

liftA2 :: (a -> b -> c) -> Rewrite a -> Rewrite b -> Rewrite c #

(*>) :: Rewrite a -> Rewrite b -> Rewrite b #

(<*) :: Rewrite a -> Rewrite b -> Rewrite a #

data Rewritten Source #

After a term is fully rewritten it is either a value or a term that requires a computational step to proceed. This types forms the interface between syntactic rewrites and computational steps.

Instances

Instances details
Show Rewritten Source # 
Instance details

Defined in Funcons.MSOS

Helpers to create rewrites & step rules

rewriteTo :: Funcons -> Rewrite Rewritten Source #

Yield a funcon term as the result of a syntactic rewrite. This function must be used instead of return. The given term is fully rewritten.

rewriteSeqTo :: [Funcons] -> Rewrite Rewritten Source #

Yield a sequence of funcon terms as the result of a rewrite. This is only valid when all terms rewrite to a value

stepTo :: Funcons -> MSOS StepRes Source #

Yield a funcon term as the result of an MSOS computation. This function must be used instead of return.

stepSeqTo :: [Funcons] -> MSOS StepRes Source #

Yield a sequence of funcon terms as the result of a computation. This is only valid when all terms rewrite to a value

compstep :: MSOS StepRes -> Rewrite Rewritten Source #

Yield an MSOS computation as a fully rewritten term. This function must be used in order to access entities in the definition of funcons.

rewritten :: Values -> Rewrite Rewritten Source #

Returns a value as a fully rewritten term.

premiseEval :: ([Values] -> Rewrite Rewritten) -> (MSOS StepRes -> MSOS StepRes) -> Funcons -> Rewrite Rewritten Source #

Execute a premise as either a rewrite or a step. Depending on whether only rewrites are necessary to yield a value, or whether a computational step is necessary, a different continuation is applied (first and second argument). Example usage:

stepScope :: NonStrictFuncon --strict in first argument
stepScope [FValue (Map e1), x] = premiseEval x rule1 step1 
 where   rule1 v  = rewritten v
         step1 stepX = do   
             Map e0  <- getInh "environment"
             x'      <- withInh "environment" (Map (union e1 e0)) stepX
             stepTo (scope_ [FValue e1, x'])

norule :: Funcons -> Rewrite a Source #

Yields an error signaling that no rule is applicable. The funcon term argument may be used to provide a useful error message.

sortErr :: Funcons -> String -> Rewrite a Source #

Yields an error signaling that a sort error was encountered. These errors render a rule inapplicable and a next rule is attempted when a backtracking procedure like evalRules is applied. The funcon term argument may be used to provide a useful error message.

partialOp :: Funcons -> String -> Rewrite a Source #

Yields an error signaling that a partial operation was applied to a value outside of its domain (e.g. division by zero). These errors render a rule inapplicable and a next rule is attempted when a backtracking procedure like evalRules is applied. The funcon term argument may be used to provide a useful error message.

Entities and entity access

type Inherited = Map Name [Values] Source #

a map storing the values of inherited entities.

getInh :: Name -> MSOS [Values] Source #

Get the value of an inherited entity.

withInh :: Name -> [Values] -> MSOS a -> MSOS a Source #

Set the value of an inherited entity. The new value is only set for MSOS computation given as a third argument.

type Mutable = Map Name Values Source #

A map storing the values of mutable entities.

getMut :: Name -> MSOS Values Source #

Get the value of some mutable entity.

putMut :: Name -> Values -> MSOS () Source #

Set the value of some mutable entity.

type Output = Map Name [Values] Source #

a map storing the values of output entities.

writeOut :: Name -> [Values] -> MSOS () Source #

Add new values to a certain output entity.

readOut :: Name -> MSOS a -> MSOS (a, [Values]) Source #

Read the values of a certain output entity. The output is obtained from the MSOS computation given as a second argument.

type Control = Map Name (Maybe Values) Source #

a map storing the values of control entities.

raiseSignal :: Name -> Values -> MSOS () Source #

Signal a value of some control entity.

receiveSignals :: [Name] -> MSOS a -> MSOS (a, [Maybe Values]) Source #

Receive the value of a control entity from a given MSOS computation.

type Input m = Map Name ([[Values]], Maybe (m Funcons)) Source #

A map storing the values of input entities.

withExtraInput :: Name -> [Values] -> MSOS a -> MSOS a Source #

Provides extra values to a certain input entity, available to be consumed by the given MSOS computation argument.

withExactInput :: Name -> [Values] -> MSOS a -> MSOS a Source #

Provides an exact amount of input for some input entity, that is to be completely consumed by the given MSOS computation. If less output is consumed a 'insufficient input consumed' exception is thrown.

CBS compilation

This section describes functions that extend the interpreter with backtracking and pattern-matching facilities. These functions are developed for compiling CBS funcon specifications to Haskell. To read about CBS we refer to JLAMP2016. The functions can be used for manual development of funcons, although this is not recommended.

Funcon representation with meta-variables

data FTerm Source #

Funcon term representation identical to Funcons, but with meta-variables.

Instances

Instances details
Eq FTerm Source # 
Instance details

Defined in Funcons.Types

Methods

(==) :: FTerm -> FTerm -> Bool #

(/=) :: FTerm -> FTerm -> Bool #

Ord FTerm Source # 
Instance details

Defined in Funcons.Types

Methods

compare :: FTerm -> FTerm -> Ordering #

(<) :: FTerm -> FTerm -> Bool #

(<=) :: FTerm -> FTerm -> Bool #

(>) :: FTerm -> FTerm -> Bool #

(>=) :: FTerm -> FTerm -> Bool #

max :: FTerm -> FTerm -> FTerm #

min :: FTerm -> FTerm -> FTerm #

Read FTerm Source # 
Instance details

Defined in Funcons.Types

Show FTerm Source # 
Instance details

Defined in Funcons.Types

Methods

showsPrec :: Int -> FTerm -> ShowS #

show :: FTerm -> String #

showList :: [FTerm] -> ShowS #

HasTypeVar FTerm Source # 
Instance details

Defined in Funcons.TypeSubstitution

type Env = Map MetaVar Levelled Source #

An environment mapping meta-variables to funcon terms. This environment is used by a substitution procedure to transform funcon terms from FTerm representation to Funcons.

emptyEnv :: Map k a Source #

The empty substitution environment. Bindings are inserted by pattern-matching.

Defining rules

rewriteTermTo :: FTerm -> Env -> Rewrite Rewritten Source #

Variant of rewriteTo that applies substitution.

stepTermTo :: FTerm -> Env -> MSOS StepRes Source #

Variant of stepTo that applies substitution.

premise :: FTerm -> [FPattern] -> Env -> MSOS Env Source #

Variant of premiseStep that applies substitute and pattern-matching.

Entity access

withInhTerm :: Name -> FTerm -> Env -> MSOS a -> MSOS a Source #

Variant of withInh that performs substitution.

getInhPatt :: Name -> [VPattern] -> Env -> MSOS Env Source #

Version of getInh that applies pattern-matching.

putMutTerm :: Name -> FTerm -> Env -> MSOS () Source #

Variant of putMut that applies substitution.

getMutPatt :: Name -> VPattern -> Env -> MSOS Env Source #

Variant of getMut that performs pattern-matching.

writeOutTerm :: Name -> FTerm -> Env -> MSOS () Source #

Variant of writeOut that applies substitution.

readOutPatt :: Name -> VPattern -> MSOS Env -> MSOS Env Source #

Variant of readOut that performs pattern-matching.

receiveSignalPatt :: Maybe Values -> Maybe VPattern -> Env -> MSOS Env Source #

Variant of receiveSignal that performs pattern-matching.

raiseTerm :: Name -> FTerm -> Env -> MSOS () Source #

Variant of raiseSignal that applies substitution.

matchInput :: Name -> VPattern -> Env -> MSOS Env Source #

Variant of consumeInput that matches the given VPattern to the consumed value in the given Env.

withExtraInputTerms :: Name -> [FTerm] -> Env -> MSOS a -> MSOS a Source #

Variant of withExtraInput that performs substitution.

withExactInputTerms :: Name -> [FTerm] -> Env -> MSOS a -> MSOS a Source #

Variant of withExactInput that performs substitution.

withControlTerm :: Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a Source #

getControlPatt :: Name -> Maybe VPattern -> Env -> MSOS Env Source #

Version of getControl that applies pattern-matching.

Backtracking

evalRules :: [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten Source #

Function evalRules implements a backtracking procedure. It receives two lists of alternatives as arguments, the first containing all rewrite rules of a funcon and the second all step rules. The first successful rule is the only rule fully executed. A rule is unsuccessful if it throws an exception. Some of these exceptions (partial operation, sort error or pattern-match failure) cause the next alternative to be tried. Other exceptions (different forms of internal errors) will be propagated further. All side-effects of attempting a rule are discarded when a rule turns out not to be applicable.

First all rewrite rules are attempted, therefore avoiding performing a step until it is absolutely necessary. This is a valid strategy as valid (I)MSOS rules can be considered in any order.

When no rules are successfully executed to completetion a 'no rule exception' is thrown.

stepRules :: [IException] -> [MSOS StepRes] -> MSOS StepRes Source #

data SideCondition Source #

CSB supports five kinds of side conditions. Each of the side conditions are explained below. When a side condition is not accepted an exception is thrown that is caught by the backtrackign procedure evalRules. A value is a ground value if it is not a thunk (and not composed out of thunks).

Constructors

SCEquality FTerm FTerm

T1 == T2. Accepted only when T1 and T2 rewrite to equal ground values.

SCInequality FTerm FTerm

T1 =/= T2. Accepted only when T1 and T2 rewrite to unequal ground values.

SCIsInSort FTerm FTerm

T1 : T2. Accepted only when T2 rewrites to a type and T1 rewrites to a value of that type.

SCNotInSort FTerm FTerm

~(T1 : T2). Accepted only when T2 rewrites to a type and T1 rewrites to a value not of that type.

SCPatternMatch FTerm [VPattern]

T = P. Accepted only when T rewrites to a value that matches the pattern P. (May produce new bindings in Env).

sideCondition :: SideCondition -> Env -> Rewrite Env Source #

Executes a side condition, given an Env environment, throwing possible exceptions, and possibly extending the environment.

lifted_sideCondition :: SideCondition -> Env -> MSOS Env Source #

Variant of sideCondition that is lifted into the MSOS monad.

Pattern Matching

data VPattern Source #

Patterns for matching values (Values).

data FPattern Source #

Patterns for matching funcon terms (FTerm).

data TPattern Source #

Instances

Instances details
Eq TPattern Source # 
Instance details

Defined in Funcons.Types

Ord TPattern Source # 
Instance details

Defined in Funcons.Types

Read TPattern Source # 
Instance details

Defined in Funcons.Types

Show TPattern Source # 
Instance details

Defined in Funcons.Types

vsMatch :: [Values] -> [VPattern] -> Env -> Rewrite Env Source #

Matching values with value patterns patterns. If the list of patterns is a singleton list, then vsMatch attempts to match the values as a tuple against the pattern as well.

fsMatch :: [Funcons] -> [FPattern] -> Env -> Rewrite Env Source #

Match a sequence of terms to a sequence of patterns.

lifted_vsMatch :: [Values] -> [VPattern] -> Env -> MSOS Env Source #

Variant of vsMatch that is lifted into the MSOS monad.

lifted_fsMatch :: [Funcons] -> [FPattern] -> Env -> MSOS Env Source #

Variant of fsMatch that is lifted into the MSOS monad. If all given terms are values, then vsMatch is used instead.

Meta-environment

envRewrite :: MetaVar -> Env -> Rewrite Env Source #

Apply as many rewrites as possible to the term bound to the given variable in the meta-environment

envStore :: MetaVar -> FTerm -> Env -> Rewrite Env Source #

lifted_envStore :: MetaVar -> FTerm -> Env -> MSOS Env Source #

Type substitution

type TypeEnv = Map MetaVar TyAssoc Source #

Associates types (Terms) with meta-variables

data TyAssoc Source #

Constructors

ElemOf FTerm 
SubTyOf FTerm 

class HasTypeVar a where Source #

Used for replacing meta-variables T in pattern annotations `P:T` with the type to which T is bound in some type-environment (if any)

Minimal complete definition

subsTypeVarWildcard

limitedSubsTypeVar :: HasTypeVar a => Set MetaVar -> TypeEnv -> a -> a Source #

Version of subsTypeVar that does not replace the meta-variables in the given set

limitedSubsTypeVarWildcard :: HasTypeVar a => Set MetaVar -> Maybe FTerm -> TypeEnv -> a -> a Source #

Version of subsTypeVarWildcard that does not replace the meta-variables in the given set

Tools for creating interpreters

Helpers for defining evaluation functions.

rewriteType :: Name -> [Values] -> Rewrite Rewritten Source #

Parameterisable evaluation function function for types.

Default entity values

type EntityDefaults = [EntityDefault] Source #

A list of EntityDefaults is used to declare (and possibly initialise) entities.

data EntityDefault Source #

Default values of entities can be specified for inherited and mutable entities.

Constructors

DefMutable Name Funcons 
DefInherited Name Funcons 
DefOutput Name

For the purpose of unit-testing it is advised to notify an interpreter of the existence of control, output and input entities as well.

DefControl Name 
DefInput Name 

Type environments

type TypeRelation = Map Name DataTypeMembers Source #

The typing environment maps datatype names to their definitions.

type TypeParam = (Maybe MetaVar, Maybe SeqSortOp, FTerm) Source #

A type parameter is of the form X:T where the name of the parameter,X, is optional. When present, X can be used to specify the type of constructors. Variable X be a sequence variable.

data DataTypeMembers Source #

A datatype has `zero or more' type parameters and `zero or more' alternatives.

Constructors

DataTypeMemberss Name [TPattern] [DataTypeAltt] 

Instances

Instances details
Show DataTypeMembers Source # 
Instance details

Defined in Funcons.Types

data DataTypeAltt Source #

An alternative is either a datatype constructor or the inclusion of some other type. The types are arbitrary funcon terms (with possible variables) that may require evaluation to be resolved to a Types.

Instances

Instances details
Show DataTypeAltt Source # 
Instance details

Defined in Funcons.Types

typeLookup :: Name -> TypeRelation -> Maybe DataTypeMembers Source #

Lookup the definition of a datatype in the typing environment.

typeEnvFromList :: [(Name, DataTypeMembers)] -> TypeRelation Source #

Creates a TypeRelation from a list.