github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00
Code Issues Projects Releases Wiki Activity

Define a let binding smart constructor using circular programming.

Browse Source
This commit is contained in:
Rob Rix 2017-09-11 09:41:46 -04:00
parent 7e55483157
commit 8e12798a05
1 changed files with 8 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Data/Functor/Binding.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE DerivingStrategies, GADTs, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies, GADTs, GeneralizedNewtypeDeriving, NoStrictData #-}
module Data.Functor.Binding
( Metavar(..)
-- Abstract binding trees
@ -6,6 +6,7 @@ module Data.Functor.Binding
, bindings
, freeMetavariables
, maxBoundMetavariable
, letBind
-- Environments
, Env(..)
, envExtend
@ -48,6 +49,12 @@ foldMaxMap :: (Foldable t, Ord b) => (a -> Maybe b) -> t a -> Maybe b
foldMaxMap f = foldr (max . f) Nothing
letBind :: (Foldable syntax, Functor syntax, Corecursive t, Recursive t, Base t ~ BindingF syntax) => t -> (Metavar -> syntax t) -> t
letBind diff f = embed (Let [(n, diff)] body)
where body = f n
n = maybe (Metavar 0) succ (foldMaxMap maxBoundMetavariable body)
newtype Env a = Env { unEnv :: [(Metavar, a)] }
deriving (Eq, Foldable, Functor, Monoid, Ord, Show, Traversable)