Merge pull request #1671 from github/free-variables-as-list

Free variables as a List (and only create a set when needed)

src/Analysis/CallGraph.hs

@@ -10,7 +10,6 @@ import qualified Algebra.Graph as G
 import Algebra.Graph.Class
 import Algebra.Graph.Export.Dot
 import Data.Abstract.FreeVariables
-import Data.Set (member)
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Declaration as Declaration
 import Data.Term
@@ -21,7 +20,7 @@ newtype CallGraph = CallGraph { unCallGraph :: G.Graph Name }
   deriving (Eq, Graph, Show)
 
 -- | Build the 'CallGraph' for a 'Term' recursively.
-buildCallGraph :: (CallGraphAlgebra syntax, FreeVariables1 syntax, Functor syntax) => Term syntax ann -> Set Name -> CallGraph
+buildCallGraph :: (CallGraphAlgebra syntax, FreeVariables1 syntax, Functor syntax) => Term syntax ann -> [Name] -> CallGraph
 buildCallGraph = foldSubterms callGraphAlgebra
 
 
@@ -35,7 +34,7 @@ renderCallGraph = export (defaultStyle friendlyName) . unCallGraph
 --   This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap.
 class CallGraphAlgebra syntax where
   -- | A 'SubtermAlgebra' computing the 'CallGraph' for a piece of @syntax@.
-  callGraphAlgebra :: FreeVariables term => syntax (Subterm term (Set Name -> CallGraph)) -> Set Name -> CallGraph
+  callGraphAlgebra :: FreeVariables term => syntax (Subterm term ([Name] -> CallGraph)) -> [Name] -> CallGraph
 
 instance (CallGraphAlgebraStrategy syntax ~ strategy, CallGraphAlgebraWithStrategy strategy syntax) => CallGraphAlgebra syntax where
   callGraphAlgebra = callGraphAlgebraWithStrategy (Proxy :: Proxy strategy)
@@ -43,7 +42,7 @@ instance (CallGraphAlgebraStrategy syntax ~ strategy, CallGraphAlgebraWithStrate
 
 -- | Types whose contribution to a 'CallGraph' is customized. If an instance’s definition is not being used, ensure that the type is mapped to 'Custom' in the 'CallGraphAlgebraStrategy'.
 class CustomCallGraphAlgebra syntax where
-  customCallGraphAlgebra :: FreeVariables term => syntax (Subterm term (Set Name -> CallGraph)) -> Set Name -> CallGraph
+  customCallGraphAlgebra :: FreeVariables term => syntax (Subterm term ([Name] -> CallGraph)) -> [Name] -> CallGraph
 
 -- | 'Declaration.Function's produce a vertex for their name, with edges to any free variables in their body.
 instance CustomCallGraphAlgebra Declaration.Function where
@@ -56,8 +55,8 @@ instance CustomCallGraphAlgebra Declaration.Method where
 -- | 'Syntax.Identifier's produce a vertex iff it’s unbound in the 'Set'.
 instance CustomCallGraphAlgebra Syntax.Identifier where
   customCallGraphAlgebra (Syntax.Identifier name) bound
-    | name `member` bound = empty
-    | otherwise           = vertex name
+    | name `elem` bound = empty
+    | otherwise         = vertex name
 
 instance Apply CallGraphAlgebra syntaxes => CustomCallGraphAlgebra (Union syntaxes) where
   customCallGraphAlgebra = Prologue.apply (Proxy :: Proxy CallGraphAlgebra) callGraphAlgebra
@@ -68,7 +67,7 @@ instance CallGraphAlgebra syntax => CustomCallGraphAlgebra (TermF syntax a) wher
 
 -- | The mechanism selecting 'Default'/'Custom' implementations for 'callGraphAlgebra' depending on the @syntax@ type.
 class CallGraphAlgebraWithStrategy (strategy :: Strategy) syntax where
-  callGraphAlgebraWithStrategy :: FreeVariables term => proxy strategy -> syntax (Subterm term (Set Name -> CallGraph)) -> Set Name -> CallGraph
+  callGraphAlgebraWithStrategy :: FreeVariables term => proxy strategy -> syntax (Subterm term ([Name] -> CallGraph)) -> [Name] -> CallGraph
 
 -- | The 'Default' definition of 'callGraphAlgebra' combines all of the 'CallGraph's within the @syntax@ 'Monoid'ally.
 instance Foldable syntax => CallGraphAlgebraWithStrategy 'Default syntax where

src/Control/Abstract/Value.hs

@@ -266,7 +266,7 @@ instance ( Monad m
 
   abstract names (Subterm body _) = do
     l <- label body
-    injValue . Closure names l . Env.bind (foldr Set.delete (freeVariables body) names) <$> getEnv
+    injValue . Closure names l . Env.bind (foldr Set.delete (Set.fromList (freeVariables body)) names) <$> getEnv
 
   apply op params = do
     Closure names label env <- maybe (fail ("expected a closure, got: " <> show op)) pure (prjValue op)

src/Data/Abstract/FreeVariables.hs

@@ -30,7 +30,7 @@ type Label = Int
 -- | Types which can contain unbound variables.
 class FreeVariables term where
   -- | The set of free variables in the given value.
-  freeVariables :: term -> Set Name
+  freeVariables :: term -> [Name]
 
 
 -- | A lifting of 'FreeVariables' to type constructors of kind @* -> *@.
@@ -38,24 +38,19 @@ class FreeVariables term where
 --   'Foldable' types requiring no additional semantics to the set of free variables (e.g. types which do not bind any variables) can use (and even derive, with @-XDeriveAnyClass@) the default implementation.
 class FreeVariables1 syntax where
   -- | Lift a function mapping each element to its set of free variables through a containing structure, collecting the results into a single set.
-  liftFreeVariables :: (a -> Set Name) -> syntax a -> Set Name
-  default liftFreeVariables :: (Foldable syntax) => (a -> Set Name) -> syntax a -> Set Name
+  liftFreeVariables :: (a -> [Name]) -> syntax a -> [Name]
+  default liftFreeVariables :: (Foldable syntax) => (a -> [Name]) -> syntax a -> [Name]
   liftFreeVariables = foldMap
 
 -- | Lift the 'freeVariables' method through a containing structure.
-freeVariables1 :: (FreeVariables1 t, FreeVariables a) => t a -> Set Name
+freeVariables1 :: (FreeVariables1 t, FreeVariables a) => t a -> [Name]
 freeVariables1 = liftFreeVariables freeVariables
 
 freeVariable :: FreeVariables term => term -> Name
-freeVariable term = case toList (freeVariables term) of
+freeVariable term = case freeVariables term of
   [n] -> n
   xs -> Prelude.fail ("expected single free variable, but got: " <> show xs)
 
--- TODO: Need a dedicated concept of qualified names outside of freevariables (a
--- Set) b/c you can have something like `a.a.b.a`
--- qualifiedName :: FreeVariables term => term -> Name
--- qualifiedName term = let names = toList (freeVariables term) in B.intercalate "." names
-
 instance (FreeVariables1 syntax, Functor syntax) => FreeVariables (Term syntax ann) where
   freeVariables = cata (liftFreeVariables id)
 

src/Data/Syntax.hs

@@ -7,7 +7,6 @@ import Data.Abstract.Evaluatable
 import Data.AST
 import Data.Range
 import Data.Record
-import qualified Data.Set as Set
 import Data.Span
 import Data.Term
 import Diffing.Algorithm hiding (Empty)
@@ -111,7 +110,7 @@ instance Evaluatable Identifier where
   eval (Identifier name) = lookupWith deref name >>= maybe (fail ("free variable: " <> show (friendlyName name))) pure
 
 instance FreeVariables1 Identifier where
-  liftFreeVariables _ (Identifier x) = Set.singleton x
+  liftFreeVariables _ (Identifier x) = pure x
 
 
 newtype Program a = Program [a]

src/Language/PHP/Syntax.hs

@@ -363,7 +363,7 @@ instance Show1 Namespace where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Namespace where
   eval Namespace{..} = go names
     where
-      names = toList (freeVariables (subterm namespaceName))
+      names = freeVariables (subterm namespaceName)
       go [] = fail "expected at least one free variable in namespaceName, found none"
       go [name] = letrec' name $ \addr ->
         subtermValue namespaceBody *> makeNamespace name addr