github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +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 module Data.Functor.Binding
( Metavar(..) ( Metavar(..)
-- Abstract binding trees -- Abstract binding trees
@ -6,6 +6,7 @@ module Data.Functor.Binding
, bindings , bindings
, freeMetavariables , freeMetavariables
, maxBoundMetavariable , maxBoundMetavariable
, letBind
-- Environments -- Environments
, Env(..) , Env(..)
, envExtend , envExtend
@ -48,6 +49,12 @@ foldMaxMap :: (Foldable t, Ord b) => (a -> Maybe b) -> t a -> Maybe b
foldMaxMap f = foldr (max . f) Nothing 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)] } newtype Env a = Env { unEnv :: [(Metavar, a)] }
deriving (Eq, Foldable, Functor, Monoid, Ord, Show, Traversable) deriving (Eq, Foldable, Functor, Monoid, Ord, Show, Traversable)