BiGUL-1.0.0.0: The Bidirectional Generic Update Language

Safe HaskellNone
LanguageHaskell2010

Generics.BiGUL

Contents

Description

This is the main module defining the syntax of BiGUL. Generics.BiGUL.TH provides some higher-level syntax for writing BiGUL programs. See Generics.BiGUL.Lib.HuStudies for some small, illustrative examples. To execute BiGUL programs, use put and get from Generics.BiGUL.Interpreter.

Synopsis

Main syntax

data BiGUL s v where

This is the datatype of BiGUL programs, as a GADT indexed with the source and view types. Most of the types appearing in a BiGUL program should be instances of Show to enable error reporting. Before GHC 8, haddock does not support documentation for GADT constructors; for GHC 7.10.*, see the source for the description of each constructor and its arguments.

Constructors

Fail :: String -> BiGUL s v 
Skip :: Eq v => (s -> v) -> BiGUL s v 
Replace :: BiGUL s s 
Prod :: (Show s, Show s', Show v, Show v') => BiGUL s v -> BiGUL s' v' -> BiGUL (s, s') (v, v') infixr 1 
RearrS :: (Show s', Show v) => Pat s env con -> Expr env s' -> BiGUL s' v -> BiGUL s v 
RearrV :: (Show s, Show v') => Pat v env con -> Expr env v' -> BiGUL s v' -> BiGUL s v 
Dep :: (Eq v', Show s, Show v) => (v -> v') -> BiGUL s v -> BiGUL s (v, v') 
Case :: [(s -> v -> Bool, CaseBranch s v)] -> BiGUL s v 
Compose :: (Show s, Show m, Show v) => BiGUL s m -> BiGUL m v -> BiGUL s v infixr 1 

data CaseBranch s v

A branch used in Case (whose type is parametrised by the source and view types) can be either Normal or Adaptive. The exit conditions specified in Normal branches should (ideally) be disjoint. Overlapping exit conditions are still allowed for fast prototyping, though — the putback semantics of Case will compute successfully as long as the ranges of the branches are disjoint (regardless of whether the exit conditions are specified precisely enough).

Constructors

Normal (BiGUL s v) (s -> Bool)

A Normal branch contains an inner program, which should update the source such that both the main condition (on both the source and view) and the exit condition (on the source) are satisfied.

Adaptive (s -> v -> s)

An Adaptive branch contains an adaptation function, which should modify the source such that a Normal branch is applicable.

Rearrangement syntax

The following pattern and expression syntax for rearrangement operations are designed to be type-safe but not intended to be programmer-friendly. The programmer is expected to use the higher-level syntax from Generics.BiGUL.TH, which desugars into the following raw syntax. For more detail about patterns and expressions, see Generics.BiGUL.PatternMatching.

data Pat a env con where

The datatype of patterns is indexed by three types: the type of values to which a pattern is applicable, the type of environments resulting from pattern matching, and the type of containers used during inverse evaluation of expressions.

Constructors

PVar :: Eq a => Pat a (Var a) (Maybe a) 
PVar' :: Pat a (Var a) (Maybe a) 
PConst :: Eq a => a -> Pat a () () 
PProd :: Pat a a' a'' -> Pat b b' b'' -> Pat (a, b) (a', b') (a'', b'') infixr 1 
PLeft :: Pat a a' a'' -> Pat (Either a b) a' a'' 
PRight :: Pat b b' b'' -> Pat (Either a b) b' b'' 
PIn :: InOut a => Pat (F a) b c -> Pat a b c 

newtype Var a

A marker for variable positions in environment types.

Constructors

Var a 

Instances

Show a => Show (Var a) 

data Direction env a where

Directions point to a variable position (marked by Var) in an environment. Their type is indexed by the environment type and the type of the variable position being pointed to.

Constructors

DVar :: Direction (Var a) a 
DLeft :: Direction a t -> Direction (a, b) t 
DRight :: Direction b t -> Direction (a, b) t 

data Expr env a where

Expressions are patterns whose variable positions contain directions pointing into some environment. Their type is indexed by the environment type and the type of the expressed value.

Constructors

EDir :: Direction env a -> Expr env a 
EConst :: Eq a => a -> Expr env a 
EProd :: Expr env a -> Expr env b -> Expr env (a, b) infixr 1 
ELeft :: Expr env a -> Expr env (Either a b) 
ERight :: Expr env b -> Expr env (Either a b) 
EIn :: InOut a => Expr env (F a) -> Expr env a