402b21a · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Fix bug in code gen for cyclic definitions

402b21aEvan Czaplicki8 years ago

builder/src/Generate/Nitpick.hs+1−1

compare with master

unifiedsplit

@@ -39,7 +39,7 @@ nodeHasDebug node =

39 Opt.Enum _ -> False

40 Opt.Box -> False

41 Opt.Link _ -> False

42− Opt.Cycle defs _ -> any (hasDebug . snd) defs

42+ Opt.Cycle vs fs _ -> any (hasDebug . snd) vs || any defHasDebug fs

43 Opt.Manager _ -> False

44 Opt.Kernel _ _ -> False

45 Opt.PortIncoming expr _ -> hasDebug expr

compiler/src/AST/Optimized.hs+3−3

@@ -150,7 +150,7 @@ data Node

150 | Enum Index.ZeroBased

151 | Box

152 | Link Global

153− | Cycle [(N.Name, Expr)] (Set.Set Global)

153+ | Cycle [(N.Name, Expr)] [Def] (Set.Set Global)

154 | Manager EffectsType

155 | Kernel KContent (Maybe KContent)

156 | PortIncoming Expr (Set.Set Global)

@@ -344,7 +344,7 @@ instance Binary Node where

344 Enum a -> putWord8 3 >> put a

345 Box -> putWord8 4

346 Link a -> putWord8 5 >> put a

347− Cycle a b -> putWord8 6 >> put a >> put b

347+ Cycle a b c -> putWord8 6 >> put a >> put b >> put c

348 Manager a -> putWord8 7 >> put a

349 Kernel a b -> putWord8 8 >> put a >> put b

350 PortIncoming a b -> putWord8 9 >> put a >> put b

@@ -359,7 +359,7 @@ instance Binary Node where

359 3 -> liftM Enum get

360 4 -> return Box

361 5 -> liftM Link get

362− 6 -> liftM2 Cycle get get

362+ 6 -> liftM3 Cycle get get get

363 7 -> liftM Manager get

364 8 -> liftM2 Kernel get get

365 9 -> liftM2 PortIncoming get get

compiler/src/Generate/JavaScript.hs+18−7

@@ -180,9 +180,9 @@ addGlobalHelp mode graph global state =

180 Opt.Link linkedGlobal ->

181 addGlobal mode graph state linkedGlobal

182

183− Opt.Cycle cycle deps ->

183+ Opt.Cycle values functions deps ->

184 addStmt (addDeps deps state) (

185− generateCycle mode global cycle

185+ generateCycle mode global values functions

186 )

187

188 Opt.Manager effectsType ->

@@ -249,13 +249,24 @@ isDebugger (Opt.Global (ModuleName.Canonical _ home) _) =

249-- GENERATE CYCLES

250

251

252−generateCycle :: Mode.Mode -> Opt.Global -> [(N.Name, Opt.Expr)] -> JS.Stmt

252+generateCycle :: Mode.Mode -> Opt.Global -> [(N.Name, Opt.Expr)] -> [Opt.Def] -> JS.Stmt

253−generateCycle mode (Opt.Global home _) cycle =

253+generateCycle mode (Opt.Global home _) values functions =

254 let

255+ funcDefs = map (generateCycleFunc mode home) functions

255− safeDefs = map (generateSafeCycle mode home) cycle

256+ safeDefs = map (generateSafeCycle mode home) values

256− realDefs = map (generateRealCycle home) cycle

257+ realDefs = map (generateRealCycle home) values

257 in

258 in

258− JS.Block (safeDefs ++ realDefs)

259+ JS.Block (funcDefs ++ safeDefs ++ realDefs)

260+

261+

262+generateCycleFunc :: Mode.Mode -> ModuleName.Canonical -> Opt.Def -> JS.Stmt

263+generateCycleFunc mode home def =

264+ case def of

265+ Opt.Def name expr ->

266+ JS.Var [ (Name.fromGlobal home name, Just (Expr.codeToExpr (Expr.generate mode expr))) ]

267+

268+ Opt.TailDef name args expr ->

269+ JS.Var [ (Name.fromGlobal home name, Just (Expr.codeToExpr (Expr.generateTailDef mode name args expr))) ]

259

270

260

271

261generateSafeCycle :: Mode.Mode -> ModuleName.Canonical -> (N.Name, Opt.Expr) -> JS.Stmt

272generateSafeCycle :: Mode.Mode -> ModuleName.Canonical -> (N.Name, Opt.Expr) -> JS.Stmt

compiler/src/Optimize/Expression.hs+14−12

@@ -1,8 +1,7 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3module Optimize.Expression

4− ( Cycle

5− , optimize

4+ ( optimize

6 , destructArgs

5 , destructArgs

7 , optimizePotentialTailCall

6 , optimizePotentialTailCall

8 )

7 )

@@ -113,7 +112,7 @@ optimize cycle (A.At region expression) =

113 case defs of

112 case defs of

114 [def] ->

113 [def] ->

115 Opt.Let

114 Opt.Let

116− <$> optimizePotentialTailCall cycle def

115+ <$> optimizePotentialTailCallDef cycle def

117 <*> optimize cycle body

116 <*> optimize cycle body

118

117

119 _ ->

118 _ ->

@@ -342,18 +341,21 @@ destructCtorArg path revDs (Can.PatternCtorArg index _ arg) =

342-- TAIL CALL

341-- TAIL CALL

343

342

344

343

345−optimizePotentialTailCall :: Cycle -> Can.Def -> Names.Tracker Opt.Def

344+optimizePotentialTailCallDef :: Cycle -> Can.Def -> Names.Tracker Opt.Def

346−optimizePotentialTailCall cycle def =

345+optimizePotentialTailCallDef cycle def =

347 case def of

346 case def of

348 Can.Def (A.At _ name) args expr ->

347 Can.Def (A.At _ name) args expr ->

349− do (argNames, destructors) <- destructArgs args

348+ optimizePotentialTailCall cycle name args expr

350− toTailDef name argNames destructors <$>

351− optimizeTail cycle name argNames expr

352

349

353 Can.TypedDef (A.At _ name) _ typedArgs expr _ ->

350 Can.TypedDef (A.At _ name) _ typedArgs expr _ ->

351+ optimizePotentialTailCall cycle name (map fst typedArgs) expr

352+

353+

354+optimizePotentialTailCall :: Cycle -> N.Name -> [Can.Pattern] -> Can.Expr -> Names.Tracker Opt.Def

355+optimizePotentialTailCall cycle name args expr =

354− do (argNames, destructors) <- destructArgs (map fst typedArgs)

356+ do (argNames, destructors) <- destructArgs args

355− toTailDef name argNames destructors <$>

357+ toTailDef name argNames destructors <$>

356− optimizeTail cycle name argNames expr

358+ optimizeTail cycle name argNames expr

357

359

358

360

359optimizeTail :: Cycle -> N.Name -> [N.Name] -> Can.Expr -> Names.Tracker Opt.Expr

361optimizeTail :: Cycle -> N.Name -> [N.Name] -> Can.Expr -> Names.Tracker Opt.Expr

@@ -392,7 +394,7 @@ optimizeTail cycle rootName argNames locExpr@(A.At _ expression) =

392 case defs of

394 case defs of

393 [def] ->

395 [def] ->

394 Opt.Let

396 Opt.Let

395− <$> optimizePotentialTailCall cycle def

397+ <$> optimizePotentialTailCallDef cycle def

396 <*> optimizeTail cycle rootName argNames body

398 <*> optimizeTail cycle rootName argNames body

397

399

398 _ ->

400 _ ->

compiler/src/Optimize/Module.hs+39−47

@@ -301,74 +301,66 @@ addDefNode home name args body mainDeps graph =

301data State =

302 State

303 { _values :: [(N.Name, Opt.Expr)]

304− , _graph :: Opt.Graph

304+ , _functions :: [Opt.Def]

305 }

306

307

308addRecDefs :: ModuleName.Canonical -> [Can.Def] -> Opt.Graph -> Opt.Graph

309−addRecDefs home defs graph =

309+addRecDefs home defs (Opt.Graph mains nodes fieldCounts) =

310 let

311− cycleValues = foldr addValueName Set.empty defs

311+ valueNames = foldr addValueName [] defs

312− dummyName = Opt.Global home (N.toCompositeName (Set.toList cycleValues))

312+ cycleName = Opt.Global home (N.toCompositeName valueNames)

313+ cycle = Set.fromList valueNames

314+ links = foldr (addLink home (Opt.Link cycleName)) Map.empty defs

313

315

314− (deps, fields, State cyclicValuePairs newGraph) =

316+ (deps, fields, State values funcs) =

315 Names.run $

317 Names.run $

316− foldM (addRecDef home dummyName cycleValues) (State [] graph) defs

318+ foldM (addRecDef cycle) (State [] []) defs

317 in

319 in

318− addToGraph dummyName (Opt.Cycle cyclicValuePairs deps) fields newGraph

320+ Opt.Graph

321+ mains

322+ (Map.insert cycleName (Opt.Cycle values funcs deps) (Map.union links nodes))

323+ (Map.unionWith (+) fields fieldCounts)

319

324

320

325

321−addValueName :: Can.Def -> Set.Set N.Name -> Set.Set N.Name

326+addValueName :: Can.Def -> [N.Name] -> [N.Name]

322−addValueName def valueNames =

327+addValueName def names =

323 case def of

328 case def of

324− Can.Def (A.At _ name) [] _ ->

329+ Can.Def (A.At _ name) args _ -> if null args then name:names else names

325− Set.insert name valueNames

330+ Can.TypedDef (A.At _ name) _ args _ _ -> if null args then name:names else names

326

331

327− Can.TypedDef (A.At _ name) _ [] _ _ ->

328− Set.insert name valueNames

329

332

330− _ ->

333+addLink :: ModuleName.Canonical -> Opt.Node -> Can.Def -> Map.Map Opt.Global Opt.Node -> Map.Map Opt.Global Opt.Node

331− valueNames

334+addLink home link def links =

335+ case def of

336+ Can.Def (A.At _ name) _ _ ->

337+ Map.insert (Opt.Global home name) link links

338+

339+ Can.TypedDef (A.At _ name) _ _ _ _ ->

340+ Map.insert (Opt.Global home name) link links

332

341

333

342

334

343

335-- ADD RECURSIVE DEFS

344-- ADD RECURSIVE DEFS

336

345

337

346

338−addRecDef :: ModuleName.Canonical -> Opt.Global -> Expr.Cycle -> State -> Can.Def -> Names.Tracker State

347+addRecDef :: Set.Set N.Name -> State -> Can.Def -> Names.Tracker State

339−addRecDef home dummyName cycle state@(State values graph) def =

348+addRecDef cycle state def =

340 case def of

349 case def of

341− Can.Def (A.At _ name) [] body ->

350+ Can.Def (A.At _ name) args body ->

342− addRecValue home dummyName cycle name body state

351+ addRecDefHelp cycle state name args body

343

352

344− Can.TypedDef (A.At _ name) _ [] body _ ->

353+ Can.TypedDef (A.At _ name) _ args body _ ->

345− addRecValue home dummyName cycle name body state

354+ addRecDefHelp cycle state name (map fst args) body

346

355

347− _ ->

348− let

349− (deps, fields, odef) =

350− Names.run (Expr.optimizePotentialTailCall cycle def)

351− in

352− pure $ State values $

353− case odef of

354− Opt.Def name body ->

355− let node = Opt.Define body deps in

356− addToGraph (Opt.Global home name) node fields graph

357−

358− Opt.TailDef name args body ->

359− let node = Opt.DefineTailFunc args body deps in

360− addToGraph (Opt.Global home name) node fields graph

361

356

357+addRecDefHelp :: Set.Set N.Name -> State -> N.Name -> [Can.Pattern] -> Can.Expr -> Names.Tracker State

358+addRecDefHelp cycle (State values funcs) name args body =

359+ case args of

360+ [] ->

361+ do obody <- Expr.optimize cycle body

362+ pure $ State ((name, obody) : values) funcs

362

363

363−addRecValue :: ModuleName.Canonical -> Opt.Global -> Expr.Cycle -> N.Name -> Can.Expr -> State -> Names.Tracker State

364+ _:_ ->

364−addRecValue home dummyName cycle name body (State values (Opt.Graph mains nodes fields)) =

365+ do odef <- Expr.optimizePotentialTailCall cycle name args body

365− do obody <- Expr.optimize cycle body

366+ pure $ State values (odef : funcs)

366−

367− let global = Opt.Global home name

368− let node = Opt.Link dummyName

369−

370− pure $

371− State

372− { _values = (name, obody) : values

373− , _graph = Opt.Graph mains (Map.insert global node nodes) fields

374− }