22df771 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Merge branch 'renamer' into tcocase

22df771Phil Freeman12 years ago

examples/passing/ShadowedRename.pursnew file+19

compare with golang

unifiedsplit

@@ -0,0 +1,19 @@

1+module Main where

3+import Control.Monad.Eff

4+import Debug.Trace

6+foreign import f

7+ "function f(x) {\

8+ \ return function () {\

9+ \ if (x !== 2) throw new Error('x is not 2');\

10+ \ }\

11+ \}" :: forall e. Number -> Eff e Number

12+

13+foo foo = let foo_1 = \_ -> foo

14+ foo_2 = foo_1 unit + 1

15+ in foo_2

16+

17+main = do

18+ f (foo 1)

19+ trace "Done"

src/Language/PureScript.hs+4−2

@@ -214,8 +214,10 @@ make outputDir opts ms = do

214 regrouped <- lift . liftError . stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated

215

216 let mod' = Module moduleName' regrouped exps

217+ let [renamed] = renameInModules [mod']

218+

217− js <- prettyPrintJS <$> moduleToJs CommonJS opts mod' env'

219+ js <- prettyPrintJS <$> moduleToJs CommonJS opts renamed env'

218− let exts = moduleToPs mod' env'

220+ let exts = moduleToPs renamed env'

219

221

220 lift $ writeTextFile jsFile js

222 lift $ writeTextFile jsFile js

221 lift $ writeTextFile externsFile exts

223 lift $ writeTextFile externsFile exts

src/Language/PureScript/Renamer.hs+42−17

@@ -19,27 +19,50 @@ import Control.Applicative

19import Control.Monad.State

21import Data.List (find)

22+

22import qualified Data.Map as M

23import qualified Data.Map as M

24+import qualified Data.Set as S

24import Language.PureScript.Declarations

26import Language.PureScript.Declarations

25import Language.PureScript.Environment

27import Language.PureScript.Environment

26import Language.PureScript.Names

28import Language.PureScript.Names

27import Language.PureScript.Traversals

29import Language.PureScript.Traversals

31+-- |

32+-- The state object used in this module

33+--

34+data RenameState = RenameState {

35+ -- |

36+ -- A map from names bound (in the input) to their names (in the output)

37+ --

38+ rsBoundNames :: M.Map Ident Ident

39+ -- |

40+ -- The set of names which have been used and are in scope in the output

41+ --

42+ , rsUsedNames :: S.Set Ident

43+ }

44+

29−type Rename = State (M.Map Ident Ident)

45+type Rename = State RenameState

46+

47+initState :: [Ident] -> RenameState

48+initState scope = RenameState (M.fromList (zip scope scope)) (S.fromList scope)

31-- |

50-- |

32-- Runs renaming starting with a list of idents for the initial scope.

51-- Runs renaming starting with a list of idents for the initial scope.

33--

52--

34runRename :: [Ident] -> Rename a -> a

53runRename :: [Ident] -> Rename a -> a

35−runRename scope = flip evalState (M.fromList $ zip scope scope)

54+runRename scope = flip evalState (initState scope)

37-- |

56-- |

38-- Creates a new renaming scope using the current as a basis. Used to backtrack

57-- Creates a new renaming scope using the current as a basis. Used to backtrack

39-- when leaving an Abs.

58-- when leaving an Abs.

40--

59--

41newScope :: Rename a -> Rename a

60newScope :: Rename a -> Rename a

42−newScope x = get >>= lift . evalStateT x

61+newScope x = do

62+ scope <- get

63+ a <- x

64+ put scope

65+ return a

44-- |

67-- |

45-- Adds a new scope entry for an ident. If the ident is already present, a new

68-- Adds a new scope entry for an ident. If the ident is already present, a new

@@ -48,14 +71,16 @@ newScope x = get >>= lift . evalStateT x

48updateScope :: Ident -> Rename Ident

71updateScope :: Ident -> Rename Ident

49updateScope name = do

72updateScope name = do

50 scope <- get

73 scope <- get

51− name' <- case M.lookup name scope of

74+ let name' = case name `S.member` rsUsedNames scope of

52− Just _ -> do

75+ True ->

76+ let

53− let newNames = map (\i -> Ident (runIdent name ++ "_" ++ show (i :: Int))) [1..]

77+ newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]

54− let (Just newName) = find (\nn -> M.lookup nn scope == Nothing) newNames

78+ Just newName = find (`S.notMember` rsUsedNames scope) newNames

55− modify $ M.insert newName newName

79+ in newName

56− return newName

80+ False -> name

57− Nothing -> return name

58− modify $ M.insert name name'

81+ modify $ \s -> s { rsBoundNames = M.insert name name' (rsBoundNames s)

82+ , rsUsedNames = S.insert name' (rsUsedNames s)

83+ }

59 return name'

84 return name'

61-- |

86-- |

@@ -63,7 +88,7 @@ updateScope name = do

63--

88--

64lookupIdent :: Ident -> Rename Ident

89lookupIdent :: Ident -> Rename Ident

65lookupIdent name = do

90lookupIdent name = do

66− name' <- gets $ M.lookup name

91+ name' <- gets $ M.lookup name . rsBoundNames

67 case name' of

92 case name' of

68 Just name'' -> return name''

93 Just name'' -> return name''

69 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"

94 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"

@@ -133,7 +158,7 @@ renameInValue (ObjectLiteral vs) =

133renameInValue (Accessor prop v) =

158renameInValue (Accessor prop v) =

134 Accessor prop <$> renameInValue v

159 Accessor prop <$> renameInValue v

135renameInValue (ObjectUpdate obj vs) =

160renameInValue (ObjectUpdate obj vs) =

136− ObjectUpdate obj <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs

161+ ObjectUpdate <$> renameInValue obj <*> mapM (\(name, v) -> (,) name <$> renameInValue v) vs

137renameInValue (Abs (Left name) v) =

162renameInValue (Abs (Left name) v) =

138 newScope $ Abs . Left <$> updateScope name <*> renameInValue v

163 newScope $ Abs . Left <$> updateScope name <*> renameInValue v

139renameInValue (App v1 v2) =

164renameInValue (App v1 v2) =

@@ -143,11 +168,11 @@ renameInValue (Var (Qualified Nothing name)) =

143renameInValue (IfThenElse v1 v2 v3) =

168renameInValue (IfThenElse v1 v2 v3) =

144 IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3

169 IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3

145renameInValue (Case vs alts) =

170renameInValue (Case vs alts) =

146− Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts

171+ newScope $ Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts

147renameInValue (TypedValue check v ty) =

172renameInValue (TypedValue check v ty) =

148 TypedValue check <$> renameInValue v <*> pure ty

173 TypedValue check <$> renameInValue v <*> pure ty

149renameInValue (Let ds v) =

174renameInValue (Let ds v) =

150− Let <$> mapM (renameInDecl False) ds <*> renameInValue v

175+ newScope $ Let <$> mapM (renameInDecl False) ds <*> renameInValue v

151renameInValue (TypeClassDictionaryConstructorApp name v) =

176renameInValue (TypeClassDictionaryConstructorApp name v) =

152 TypeClassDictionaryConstructorApp name <$> renameInValue v

177 TypeClassDictionaryConstructorApp name <$> renameInValue v

153renameInValue (PositionedValue pos v) =

178renameInValue (PositionedValue pos v) =

@@ -158,8 +183,8 @@ renameInValue v = return v

158-- Renames within case alternatives.

183-- Renames within case alternatives.

159--

184--

160renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative

185renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative

161−renameInCaseAlternative (CaseAlternative bs g v) =

186+renameInCaseAlternative (CaseAlternative bs g v) =

162− newScope $ CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v

187+ CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v

163

188

164-- |

189-- |

165-- Renames within binders.

190-- Renames within binders.