github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00
Code Issues Projects Releases Wiki Activity

Define a catamorphism over Terms.

Browse Source
This commit is contained in:
Rob Rix 2019-07-17 11:19:30 -04:00
parent 43061122b9
commit d1c6d9fab8
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 12 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
semantic-core/src/Data/Term.hs
View File

@ -3,11 +3,14 @@ module Data.Term
( Term(..)
, Syntax(..)
, iter
, cata
) where
import Control.Effect.Carrier
import Control.Monad (ap)
import Control.Monad.Module
import Data.Coerce (coerce)
import Data.Functor.Const
import Data.Scope
data Term sig a
@ -74,3 +77,12 @@ iter var alg bound = go
go free = \case
Var a -> var (free a)
Term t -> alg (foldSyntax go bound free t)
cata :: Syntax sig
=> (a -> b)
-> (forall a . sig (Const b) a -> b)
-> (Incr () b -> a)
-> (x -> a)
-> Term sig x
-> b
cata var alg k h = getConst . iter (coerce var) (Const . alg) (coerce k) (Const . h)