static-0.1.0.0: Type-safe and interoperable static values and closures

Safe HaskellNone
LanguageHaskell2010

Control.Static.Closure

Synopsis

Documentation

type ClosureFunc cxt env arg res = CxtW cxt (env -> arg -> res) Source #

Closure, internal representation.

The type parameter env is meant for a bag of functions known statically at compile time, that you don't need to serialise and so don't want the added complexity of dealing with $(mkStatic). For example, if your function takes in extra utility functions, but these are all statically-known. The type parameter cxt are the constraint types, which is effectively similar to env except that Haskell deals with them slightly differently.

type ClosureApply g = SKeyedExt g Source #

An applied closure, consisting of its static key and an argument.

applyClosure :: RepVal g arg k => SKeyed k (CxtW cxt (env -> arg -> res)) -> arg -> ClosureApply g Source #

Create a ClosureApply in its serialisable static form.

envTabCons :: SKeyed k (CxtW cxt (env -> arg -> res)) -> env -> TTab kk vv -> TTab (k ': kk) (env ': vv) Source #

envTabNil :: TTab '[] '[] Source #

class Closure (Part pcl) => PreClosure pcl where Source #

A pre-closure is a function that takes two statically-known arguments: a constraint, and an explicit argument; and gives a closure.

Typically, you define a bunch of top-level functions of the form (ctx => env -> arg -> res), then create a table of pre-closures using the TH function mkStaticTab.

Associated Types

type Cxt pcl :: Constraint Source #

type Env pcl Source #

type Part pcl Source #

Methods

applyPre :: Cxt pcl => pcl -> Env pcl -> Part pcl Source #

Instances
PreClosure (CxtW c (e -> v -> r)) Source # 
Instance details

Defined in Control.Static.Closure

Associated Types

type Cxt (CxtW c (e -> v -> r)) :: Constraint Source #

type Env (CxtW c (e -> v -> r)) :: Type Source #

type Part (CxtW c (e -> v -> r)) :: Type Source #

Methods

applyPre :: CxtW c (e -> v -> r) -> Env (CxtW c (e -> v -> r)) -> Part (CxtW c (e -> v -> r)) Source #

class Closure cl where Source #

A closure is a function that takes a runtime argument, and gives a result.

It is created by applying a constraint and environment to a pre-closure. Typically you do this once on a table of pre-closures, using mkClosureTab.

Associated Types

type Arg cl Source #

type Res cl Source #

Methods

apply :: cl -> Arg cl -> Res cl Source #

Instances
Closure (v -> r) Source # 
Instance details

Defined in Control.Static.Closure

Associated Types

type Arg (v -> r) :: Type Source #

type Res (v -> r) :: Type Source #

Methods

apply :: (v -> r) -> Arg (v -> r) -> Res (v -> r) Source #

class PostClosure x f where Source #

A post-closure is a function that takes a runtime result, and converts all the results of all different closures into the same type.

Associated Types

type Pre f Source #

Methods

applyPost :: f -> Pre f -> x Source #

Instances
PostClosure x (r -> x) Source # 
Instance details

Defined in Control.Static.Closure

Associated Types

type Pre (r -> x) :: Type Source #

Methods

applyPost :: (r -> x) -> Pre (r -> x) -> x Source #

type CxtSym1 (pcl6989586621679210425 :: Type) = Cxt pcl6989586621679210425 Source #

data CxtSym0 :: (~>) Type Constraint where Source #

Constructors

CxtSym0KindInference :: forall pcl6989586621679210425 arg. SameKind (Apply CxtSym0 arg) (CxtSym1 arg) => CxtSym0 pcl6989586621679210425 
Instances
SuppressUnusedWarnings CxtSym0 Source # 
Instance details

Defined in Control.Static.Closure

type Apply CxtSym0 (pcl6989586621679210425 :: Type) Source # 
Instance details

Defined in Control.Static.Closure

type Apply CxtSym0 (pcl6989586621679210425 :: Type) = Cxt pcl6989586621679210425

type EnvSym1 (pcl6989586621679210425 :: Type) = Env pcl6989586621679210425 Source #

data EnvSym0 :: (~>) Type Type where Source #

Constructors

EnvSym0KindInference :: forall pcl6989586621679210425 arg. SameKind (Apply EnvSym0 arg) (EnvSym1 arg) => EnvSym0 pcl6989586621679210425 
Instances
SuppressUnusedWarnings EnvSym0 Source # 
Instance details

Defined in Control.Static.Closure

type Apply EnvSym0 (pcl6989586621679210425 :: Type) Source # 
Instance details

Defined in Control.Static.Closure

type Apply EnvSym0 (pcl6989586621679210425 :: Type) = Env pcl6989586621679210425

type PartSym1 (pcl6989586621679210425 :: Type) = Part pcl6989586621679210425 Source #

data PartSym0 :: (~>) Type Type where Source #

Constructors

PartSym0KindInference :: forall pcl6989586621679210425 arg. SameKind (Apply PartSym0 arg) (PartSym1 arg) => PartSym0 pcl6989586621679210425 
Instances
SuppressUnusedWarnings PartSym0 Source # 
Instance details

Defined in Control.Static.Closure

type Apply PartSym0 (pcl6989586621679210425 :: Type) Source # 
Instance details

Defined in Control.Static.Closure

type Apply PartSym0 (pcl6989586621679210425 :: Type) = Part pcl6989586621679210425

type ArgSym1 (cl6989586621679210424 :: Type) = Arg cl6989586621679210424 Source #

data ArgSym0 :: (~>) Type Type where Source #

Constructors

ArgSym0KindInference :: forall cl6989586621679210424 arg. SameKind (Apply ArgSym0 arg) (ArgSym1 arg) => ArgSym0 cl6989586621679210424 
Instances
SuppressUnusedWarnings ArgSym0 Source # 
Instance details

Defined in Control.Static.Closure

type Apply ArgSym0 (cl6989586621679210424 :: Type) Source # 
Instance details

Defined in Control.Static.Closure

type Apply ArgSym0 (cl6989586621679210424 :: Type) = Arg cl6989586621679210424

type ResSym1 (cl6989586621679210424 :: Type) = Res cl6989586621679210424 Source #

data ResSym0 :: (~>) Type Type where Source #

Constructors

ResSym0KindInference :: forall cl6989586621679210424 arg. SameKind (Apply ResSym0 arg) (ResSym1 arg) => ResSym0 cl6989586621679210424 
Instances
SuppressUnusedWarnings ResSym0 Source # 
Instance details

Defined in Control.Static.Closure

type Apply ResSym0 (cl6989586621679210424 :: Type) Source # 
Instance details

Defined in Control.Static.Closure

type Apply ResSym0 (cl6989586621679210424 :: Type) = Res cl6989586621679210424

type PreSym1 (f6989586621679210423 :: Type) = Pre f6989586621679210423 Source #

data PreSym0 :: (~>) Type Type where Source #

Constructors

PreSym0KindInference :: forall f6989586621679210423 arg. SameKind (Apply PreSym0 arg) (PreSym1 arg) => PreSym0 f6989586621679210423 
Instances
SuppressUnusedWarnings PreSym0 Source # 
Instance details

Defined in Control.Static.Closure

type Apply PreSym0 (f6989586621679210423 :: Type) Source # 
Instance details

Defined in Control.Static.Closure

type Apply PreSym0 (f6989586621679210423 :: Type) = Pre f6989586621679210423

type ResCont x = TyContSym1 x .@#@$$$ ResSym0 Source #

A continuation from the result type to x.

applyClosureTabPre :: forall c1 kk vv. ConstrainList (Fmap CxtSym0 vv) => TCTab' PreClosure kk vv -> TCTab c1 kk (Fmap EnvSym0 vv) -> TCTab' Closure kk (Fmap PartSym0 vv) Source #

Apply a table of pre-closures to its inputs, creating a table of closures.

applyClosureTab :: forall c1 kk vv. TCTab' Closure kk vv -> TCTab c1 kk (Fmap ArgSym0 vv) -> TTab kk (Fmap ResSym0 vv) Source #

Apply a table of closures to its inputs, creating a table of results.

applyClosureTabPost :: forall c0 kk rr x. TCTab c0 kk rr -> TCTab' (PostClosure x) kk (Fmap (TyContSym1 x) rr) -> TTab kk (Fmap (ConstSym1 x) rr) Source #

Apply a table of results to its post-closures, creating a table of values.

evalClosureTab :: forall (kk :: [Symbol]) vv x. TCTab' Closure kk vv -> TTab kk (Fmap ArgSym0 vv) -> TCTab' (PostClosure x) kk (Fmap (ResCont x) vv) -> TTab kk (Fmap (ConstSym1 x) vv) Source #

Apply a table of closures to a table of inputs and post-closures, giving a table of values.

This method is just a demo, users will want one of the exported functions.

mkClosureTab :: forall c1 kk vv. ConstrainList (Fmap CxtSym0 vv) => ConstrainList (ZipWith (ConstSym1 (TyCon1 PreClosure)) kk vv) => TTab kk vv -> TCTab c1 kk (Fmap EnvSym0 vv) -> TCTab' Closure kk (Fmap PartSym0 vv) Source #

Create a table of closures from a table of pre-closures.

We apply the relevant constraints and environment arguments, statically-known at compile time.

type RepClosure c g = RepExtSym3 (AndC2 (ConstSym1 (TyCon1 Closure)) (FlipSym2 (.@#@$) ResSym0 .@#@$$$ c)) g ArgSym0 Source #

RepClosure c g k v is a constraint comprising:

  • RepVal g (Arg v) k
  • c k (Res v)
  • Closure v

modulo singletons defunctionalisation on c.

type RepClosure' r g = RepClosure (ConstSym1 (TyCon1 ((~) r))) g Source #

A RepClosure whose result is exactly r.

repClosureTab :: forall c g (kk :: [Symbol]) vv. ConstrainList (ZipWith (FlipSym2 (.@#@$) ResSym0 .@#@$$$ c) kk vv) => ConstrainList (ZipWith (FlipSym1 (TyCon2 (RepVal g) .@#@$$$ ApplySym1 ArgSym0)) kk vv) => TCTab' Closure kk vv -> TCTab (RepClosure c g) kk vv Source #

Convert a Closure table into a RepClosure table, deducing constraints.

This is used to convert the result of mkClosureTab into a form that can be passed to the other functions e.g. evalSomeClosure.

withEvalClosureCts :: forall c g (k :: Symbol) (kk :: [Symbol]) vv x. TCTab (RepClosure c g) kk vv -> SKeyed k g -> TCTab' (PostClosure x) kk (Fmap (ResCont x) vv) -> Either SKeyedError x Source #

Apply a closure table to a single input and a post-processing table, giving a single result (if the input key was found).

This is the statically-typed version; for a version that runs for unknown keys see withEvalSomeClosureCts.

withEvalSomeClosureCts :: forall c g (kk :: [Symbol]) vv x. TCTab (RepClosure c g) kk vv -> ClosureApply g -> TCTab' (PostClosure x) kk (Fmap (ResCont x) vv) -> Either SKeyedError x Source #

Apply a closure table to a single input and a post-processing table, giving a single result (if the input key was found).

This is the dynamically-typed version; for a version that type-checks for statically-known keys see withEvalClosureCts.

withEvalClosureCxt :: forall c f g (k :: Symbol) (kk :: [Symbol]) vv r. TCTab (RepClosure c g) kk vv -> SKeyed k g -> (forall k' v. Just '(k', v) ~ LookupKV k kk vv => ProofLookupKV f k kk vv => (c @@ k') @@ Res v => Sing k' -> Res v -> r) -> Either SKeyedError r Source #

Apply a closure table to a single input, and pass the constrained result to a continuation (if the input key was found).

This is the statically-typed version; for a version that runs for unknown keys see withEvalSomeClosureCxt.

withEvalSomeClosureCxt :: forall c f g (kk :: [Symbol]) vv r. TCTab (RepClosure c g) kk vv -> ClosureApply g -> (forall k k' v. Just '(k', v) ~ LookupKV k kk vv => ProofLookupKV f k kk vv => (c @@ k') @@ Res v => Sing k' -> Res v -> r) -> Either SKeyedError r Source #

Apply a closure table to a single input, and pass the constrained result to a continuation (if the input key was found).

This is the dynamically-typed version; for a version that type-checks for statically-known keys see withEvalClosureCxt.

evalClosure :: forall g (k :: Symbol) (kk :: [Symbol]) vv r. TCTab (RepClosure' r g) kk vv -> SKeyed k g -> Either SKeyedError r Source #

Evaluate a closure application with statically-known type, against a table of closures, that all have the same result type.

evalSomeClosure :: forall g (kk :: [Symbol]) vv r. TCTab (RepClosure' r g) kk vv -> ClosureApply g -> Either SKeyedError r Source #

Evaluate a closure application with statically-unknown type, against a table of closures, that all have the same result type.