mirror of
https://github.com/github/semantic.git
synced 2024-12-23 06:41:45 +03:00
Compute the free metavariables in an ABT.
This commit is contained in:
parent
65c418359a
commit
d064e3f1e5
@ -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)
|
||||||
|
Loading…
Reference in New Issue
Block a user