499e6d9 · elk · git.iko.soy

src/AST/Variable.hs+27−7

compare with master

unifiedsplit

@@ -20,6 +20,7 @@ newtype Raw = Raw String

20data Home

21 = BuiltIn

22 | Module [String]

23+ | TopLevel [String]

23 | Local

24 | Local

24 deriving (Eq, Ord, Show)

25 deriving (Eq, Ord, Show)

25

26

@@ -32,11 +33,18 @@ data Canonical = Canonical

32

33

34

34local :: String -> Canonical

35local :: String -> Canonical

36+local x =

35−local x = Canonical Local x

37+ Canonical Local x

38+

39+

40+topLevel :: [String] -> String -> Canonical

41+topLevel names x =

42+ Canonical (TopLevel names) x

36

43

37

44

38builtin :: String -> Canonical

45builtin :: String -> Canonical

46+builtin x =

39−builtin x = Canonical BuiltIn x

47+ Canonical BuiltIn x

40

48

41

49

42fromModule :: [String] -> String -> Canonical

50fromModule :: [String] -> String -> Canonical

@@ -122,9 +130,17 @@ instance ToString Raw where

122instance ToString Canonical where

130instance ToString Canonical where

123 toString (Canonical home name) =

131 toString (Canonical home name) =

124 case home of

132 case home of

125− BuiltIn -> name

133+ BuiltIn ->

134+ name

135+

136+ Module path ->

126− Module path -> List.intercalate "." (path ++ [name])

137+ List.intercalate "." (path ++ [name])

138+

139+ TopLevel _ ->

140+ name

141+

127− Local -> name

142+ Local ->

143+ name

128

144

129

145

130-- LISTINGS

146-- LISTINGS

@@ -249,15 +265,19 @@ instance Binary Canonical where

249 Module path ->

265 Module path ->

250 putWord8 1 >> put path >> put name

266 putWord8 1 >> put path >> put name

251

267

268+ TopLevel path ->

269+ putWord8 2 >> put path >> put name

270+

252 Local ->

271 Local ->

253− putWord8 2 >> put name

272+ putWord8 3 >> put name

254

273

255 get =

274 get =

256 do tag <- getWord8

275 do tag <- getWord8

257 case tag of

276 case tag of

258 0 -> Canonical BuiltIn <$> get

277 0 -> Canonical BuiltIn <$> get

259 1 -> Canonical . Module <$> get <*> get

278 1 -> Canonical . Module <$> get <*> get

260− 2 -> Canonical Local <$> get

279+ 2 -> Canonical . TopLevel <$> get <*> get

280+ 3 -> Canonical Local <$> get

261 _ -> error "Unexpected tag when deserializing canonical variable"

281 _ -> error "Unexpected tag when deserializing canonical variable"

262

282

263

283

src/Canonicalize/Setup.hs+11−9

@@ -282,16 +282,18 @@ declarationsToPatches moduleName decls =

282 (Maybe.catMaybes maybeNodes, concat patchLists)

283

284

285−-- When canonicalizing, all _values should be Local, but all _adts and _patterns

285+-- When canonicalizing, it is important that:

286−-- should be fully namespaced. With _adts, they may appear in types that can

286+-- _adts are fully namespaced (Var.Module ...)

287−-- escape the module.

287+-- _patterns are fully namespaced (Var.Module ...)

288+-- _values that are defined as top-level declarations are (Var.TopLevel ...)

289+-- all other _values are local (Var.Local)

288declToPatches

290declToPatches

289 :: Module.Name

291 :: Module.Name

290 -> D.ValidDecl

292 -> D.ValidDecl

291 -> (Maybe Node, [Env.Patch])

293 -> (Maybe Node, [Env.Patch])

292declToPatches moduleName (A.A (region,_) decl) =

294declToPatches moduleName (A.A (region,_) decl) =

293− let local mkPatch x =

295+ let topLevel mkPatch x =

294− mkPatch x (Var.local x)

296+ mkPatch x (Var.topLevel moduleName x )

295

297

296 namespaced mkPatch x =

298 namespaced mkPatch x =

297 mkPatch x (Var.fromModule moduleName x)

299 mkPatch x (Var.fromModule moduleName x)

@@ -302,7 +304,7 @@ declToPatches moduleName (A.A (region,_) decl) =

302 case decl of

304 case decl of

303 D.Definition (Valid.Definition pattern _ _) ->

305 D.Definition (Valid.Definition pattern _ _) ->

304 ( Nothing

306 ( Nothing

305− , map (local Env.Value) (P.boundVarList pattern)

307+ , map (topLevel Env.Value) (P.boundVarList pattern)

306 )

308 )

307

309

308 D.Datatype name _ ctors ->

310 D.Datatype name _ ctors ->

@@ -310,7 +312,7 @@ declToPatches moduleName (A.A (region,_) decl) =

310 in

312 in

311 ( Nothing

313 ( Nothing

312 , namespaced Env.Union name

314 , namespaced Env.Union name

313− : map (local Env.Value) ctorNames

315+ : map (topLevel Env.Value) ctorNames

314 ++ map patternPatch ctors

316 ++ map patternPatch ctors

315 )

317 )

316

318

@@ -318,14 +320,14 @@ declToPatches moduleName (A.A (region,_) decl) =

318 ( Just (node region name tvars alias)

320 ( Just (node region name tvars alias)

319 , case alias of

321 , case alias of

320 A.A _ (Type.RRecord _ _) ->

322 A.A _ (Type.RRecord _ _) ->

321− [local Env.Value name]

323+ [topLevel Env.Value name]

322 _ ->

324 _ ->

323 []

325 []

324 )

326 )

325

327

326 D.Port port ->

328 D.Port port ->

327 ( Nothing

329 ( Nothing

328− , [local Env.Value (D.validPortName port)]

330+ , [topLevel Env.Value (D.validPortName port)]

329 )

331 )

330

332

331 D.Fixity _ _ _ ->

333 D.Fixity _ _ _ ->

src/Canonicalize/Sort.hs+2

@@ -31,6 +31,7 @@ freeIfLocal :: V.Canonical -> State (Set.Set String) ()

31freeIfLocal (V.Canonical home name) =

32 case home of

33 V.Local -> free name

34+ V.TopLevel _ -> free name

34 V.BuiltIn -> return ()

35 V.BuiltIn -> return ()

35 V.Module _ -> return ()

36 V.Module _ -> return ()

36

37

@@ -164,6 +165,7 @@ ctors (A.A _ pattern) =

164 P.Data (V.Canonical home name) ps ->

165 P.Data (V.Canonical home name) ps ->

165 case home of

166 case home of

166 V.Local -> name : rest

167 V.Local -> name : rest

168+ V.TopLevel _ -> name : rest

167 V.BuiltIn -> rest

169 V.BuiltIn -> rest

168 V.Module _ -> rest

170 V.Module _ -> rest

169 where

171 where

src/Canonicalize/Variable.hs+38−12

@@ -30,10 +30,10 @@ variable region env var =

30 Just [v] ->

31 Result.var v

32

33− Just vs ->

33+ Just vs ->

34 preferLocals region env "variable" vs var

35

36− Nothing ->

36+ Nothing ->

37 notFound region "variable" (Map.keys (Env._values env)) var

38

39

@@ -110,30 +110,56 @@ preferLocals'

110 -> String

111 -> Result.ResultErr a

112preferLocals' region env extract kind possibilities var =

113− case filter (isLocal . extract) possibilities of

113+ case filter (isLocal (Env._home env) . extract) possibilities of

114 [] ->

115 ambiguous possibilities

116

117 [v] ->

118 Result.var' extract v

119

120+ --Local vars shadow top-level vars

121+ [v1, v2]

122+ | isTopLevel (extract v1) ->

123+ Result.var' extract v2

124+

125+ | isTopLevel (extract v2) ->

126+ Result.var' extract v1

127+

120 locals ->

128 locals ->

121 ambiguous locals

129 ambiguous locals

122 where

130 where

123− isLocal :: Var.Canonical -> Bool

124− isLocal (Var.Canonical home _) =

125− case home of

126− Var.Local -> True

127− Var.BuiltIn -> False

128− Var.Module name ->

129− name == Env._home env

130−

131 ambiguous possibleVars =

132 Result.err (A.A region (Error.variable kind var Error.Ambiguous vars))

133 where

134 vars = map (Var.toString . extract) possibleVars

135

136

137+isLocal :: [String] -> Var.Canonical -> Bool

138+isLocal contextName (Var.Canonical home _) =

139+ case home of

140+ Var.Local ->

141+ True

142+

143+ Var.TopLevel _ ->

144+ True

145+

146+ Var.BuiltIn ->

147+ False

148+

149+ Var.Module name ->

150+ name == contextName

151+

152+

153+isTopLevel :: Var.Canonical -> Bool

154+isTopLevel (Var.Canonical home _) =

155+ case home of

156+ Var.TopLevel _ ->

157+ True

158+

159+ _ ->

160+ False

161+

162+

137-- NOT FOUND HELPERS

163-- NOT FOUND HELPERS

138

164

139type VarName =

165type VarName =

@@ -224,4 +250,4 @@ qualifiedProblem moduleName name allQualified =

224 , Set.toList availableModules

250 , Set.toList availableModules

225 |> map Module.nameToString

251 |> map Module.nameToString

226 |> Error.nearbyNames id moduleNameString

252 |> Error.nearbyNames id moduleNameString

227− )

253+ )

src/Generate/JavaScript.hs+8

@@ -351,6 +351,12 @@ isTailCall tcc (A.A _ func) arity =

351 else

352 Nothing

353

354+ (Var (Var.Canonical (Var.TopLevel _) name), Just (tcName, tcArgs, tcLabel)) ->

355+ if name == tcName && length tcArgs == arity then

356+ Just (tcArgs, tcLabel)

357+ else

358+ Nothing

359+

354 _ ->

360 _ ->

355 Nothing

361 Nothing

356

362

@@ -516,6 +522,8 @@ generateCase tcc expr branches =

516 case expr of

522 case expr of

517 A.A _ (Var (Var.Canonical Var.Local x)) ->

523 A.A _ (Var (Var.Canonical Var.Local x)) ->

518 return (Case.matchSubst [(tempVar, Var.varName x)] initialMatch, [])

524 return (Case.matchSubst [(tempVar, Var.varName x)] initialMatch, [])

525+ A.A _ (Var (Var.Canonical (Var.TopLevel _) x)) ->

526+ return (Case.matchSubst [(tempVar, Var.varName x)] initialMatch, [])

519 _ ->

527 _ ->

520 do expr' <- toJsExpr expr

528 do expr' <- toJsExpr expr

521 return (initialMatch, [VarDeclStmt () [varDecl tempVar expr']])

529 return (initialMatch, [VarDeclStmt () [varDecl tempVar expr']])

src/Generate/JavaScript/Variable.hs+1

@@ -23,6 +23,7 @@ canonical (Var.Canonical home name) =

23 home' =

24 case home of

25 Var.Local -> []

26+ Var.TopLevel _ -> []

26 Var.BuiltIn -> []

27 Var.BuiltIn -> []

27 Var.Module path -> [ moduleName path ]

28 Var.Module path -> [ moduleName path ]

28

29

src/Optimize/Substitute.hs+4−1

@@ -58,6 +58,9 @@ subst old new expression =

58 V.Local ->

59 if x == old then new else expression

60

61+ V.TopLevel _ ->

62+ if x == old then new else expression

63+

61 Case e cases ->

64 Case e cases ->

62 Case (f e) (map substCase cases)

65 Case (f e) (map substCase cases)

63 where

66 where

@@ -103,4 +106,4 @@ subst old new expression =

103 Task name (f expr) tipe

106 Task name (f expr) tipe

104

107

105 Crash _ ->

108 Crash _ ->

106− expression

109+ expression

src/Optimize/TailCalls.hs+2

@@ -130,6 +130,8 @@ findTailCalls context annExpr@(A.A _ expression) =

130 case (context, func) of

131 ( Just (name, argNum), A.A _ (Var (Var.Canonical Var.Local name')) ) ->

132 name == name' && length args == argNum

133+ ( Just (name, argNum), A.A _ (Var (Var.Canonical (Var.TopLevel _) name')) ) ->

134+ name == name' && length args == argNum

133 _ ->

135 _ ->

134 False

136 False

135

137

src/Type/Unify.hs+4

@@ -126,6 +126,10 @@ actuallyUnify variable1 variable2 = do

126

127 Var.Local | List.isPrefixOf "number" name ->

128 flexAndUnify svar

129+

130+ Var.TopLevel _ | List.isPrefixOf "number" name ->

131+ flexAndUnify svar

132+

129 _ ->

133 _ ->

130 typeError variable1 variable2 Nothing

134 typeError variable1 variable2 Nothing

131

135