From d064e3f1e5bbd841253bfede7467389cd0c4ae36 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 11 Sep 2017 09:35:51 -0400
Subject: [PATCH] Compute the free metavariables in an ABT.

---
 src/Data/Functor/Binding.hs | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/src/Data/Functor/Binding.hs b/src/Data/Functor/Binding.hs
index b3410ba48..c45be3251 100644
--- a/src/Data/Functor/Binding.hs
+++ b/src/Data/Functor/Binding.hs
@@ -1,9 +1,10 @@
-{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DerivingStrategies, GADTs, GeneralizedNewtypeDeriving #-}
 module Data.Functor.Binding
 ( Metavar(..)
 -- Abstract binding trees
 , BindingF(..)
 , bindings
+, freeMetavariables
 -- Environments
 , Env(..)
 , envExtend
@@ -11,8 +12,11 @@ module Data.Functor.Binding
 ) where
 
 import Data.Aeson (KeyValue(..), ToJSON(..), object, pairs)
+import Data.Foldable (fold)
 import Data.Functor.Classes
+import Data.Functor.Foldable hiding (fold)
 import Data.JSON.Fields
+import qualified Data.Set as Set
 import Data.Text.Prettyprint.Doc
 
 newtype Metavar = Metavar Int
@@ -28,6 +32,11 @@ bindings :: BindingF f recur -> [(Metavar, recur)]
 bindings (Let vars _) = vars
 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)] }
   deriving (Eq, Foldable, Functor, Monoid, Ord, Show, Traversable)