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

Compute the free metavariables in an ABT.

Browse Source
This commit is contained in:
Rob Rix 2017-09-11 09:35:51 -04:00
parent 65c418359a
commit d064e3f1e5
1 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,9 +1,10 @@
{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving #-} {-# LANGUAGE DerivingStrategies, GADTs, GeneralizedNewtypeDeriving #-}
module Data.Functor.Binding module Data.Functor.Binding
( Metavar(..) ( Metavar(..)
-- Abstract binding trees -- Abstract binding trees
, BindingF(..) , BindingF(..)
, bindings , bindings
, freeMetavariables
-- Environments -- Environments
, Env(..) , Env(..)
, envExtend , envExtend
@ -11,8 +12,11 @@ module Data.Functor.Binding
) where ) where
import Data.Aeson (KeyValue(..), ToJSON(..), object, pairs) import Data.Aeson (KeyValue(..), ToJSON(..), object, pairs)
import Data.Foldable (fold)
import Data.Functor.Classes import Data.Functor.Classes
import Data.Functor.Foldable hiding (fold)
import Data.JSON.Fields import Data.JSON.Fields
import qualified Data.Set as Set
import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc
newtype Metavar = Metavar Int newtype Metavar = Metavar Int
@ -28,6 +32,11 @@ bindings :: BindingF f recur -> [(Metavar, recur)]
bindings (Let vars _) = vars bindings (Let vars _) = vars
bindings _ = [] bindings _ = []
freeMetavariables :: (Foldable syntax, Functor syntax, Recursive t, Base t ~ BindingF syntax) => t -> Set.Set Metavar
freeMetavariables = cata $ \ diff -> case diff of
Let bindings body -> foldMap snd bindings <> foldr Set.delete (fold body) (fst <$> bindings)
Var v -> Set.singleton v
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)