Skip to content

Commit

Permalink
Fix #611 - do not take locally-bound names into account when calculat…
Browse files Browse the repository at this point in the history
…ing binding groups
  • Loading branch information
paf31 committed Oct 15, 2014
1 parent e070c0e commit 02a7452
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 5 deletions.
8 changes: 8 additions & 0 deletions examples/passing/BindingGroups.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
module Main where

foo = bar
where bar r = r + 1

r = foo 2

main = Debug.Trace.trace "Done"
18 changes: 13 additions & 5 deletions src/Language/PureScript/Sugar/BindingGroups.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,8 @@ import Data.List (nub, intersect)
import Data.Maybe (isJust, mapMaybe)
import Control.Applicative ((<$>), (<*>), pure)

import qualified Data.Set as S

import Language.PureScript.Declarations
import Language.PureScript.Names
import Language.PureScript.Types
Expand Down Expand Up @@ -91,13 +93,19 @@ collapseBindingGroupsForValue other = other

usedIdents :: ModuleName -> Declaration -> [Ident]
usedIdents moduleName =
let (f, _, _, _, _) = everythingOnValues (++) (const []) usedNames (const []) (const []) (const [])
let (f, _, _, _, _) = everythingWithContextOnValues S.empty [] (++) def usedNamesE usedNamesB def def
in nub . f
where
usedNames :: Expr -> [Ident]
usedNames (Var (Qualified Nothing name)) = [name]
usedNames (Var (Qualified (Just moduleName') name)) | moduleName == moduleName' = [name]
usedNames _ = []
def s _ = (s, [])

usedNamesE :: S.Set Ident -> Expr -> (S.Set Ident, [Ident])
usedNamesE scope (Var (Qualified Nothing name)) | name `S.notMember` scope = (scope, [name])
usedNamesE scope (Var (Qualified (Just moduleName') name)) | moduleName == moduleName' && name `S.notMember` scope = (scope, [name])
usedNamesE scope (Abs (Left name) _) = (name `S.insert` scope, [])
usedNamesE scope _ = (scope, [])

usedNamesB :: S.Set Ident -> Binder -> (S.Set Ident, [Ident])
usedNamesB scope binder = (scope `S.union` S.fromList (binderNames binder), [])

usedProperNames :: ModuleName -> Declaration -> [ProperName]
usedProperNames moduleName =
Expand Down

0 comments on commit 02a7452

Please sign in to comment.