2d29699 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Make separate type for the optimized AST

2d29699Evan Czaplicki11 years ago

src/AST/Expression/Optimized.hs+32−20

compare with master

unifiedsplit

@@ -1,36 +1,48 @@

1{-# OPTIONS_GHC -Wall #-}

2module AST.Expression.Optimized

3− ( Expr, Expr'

3+ ( Expr(..)

4 , Def(..)

5− , Facts(..), dummyFacts

5+ , Facts(..)

6 ) where

8+import qualified Data.Map as Map

8import qualified AST.Expression.General as General

10import qualified AST.Expression.General as General

9−import qualified AST.Pattern as Pattern

11+import qualified AST.Literal as Literal

12+import qualified AST.Module.Name as ModuleName

10import qualified AST.Type as Type

13import qualified AST.Type as Type

11import qualified AST.Variable as Var

14import qualified AST.Variable as Var

12−

15+import qualified Optimize.Cases as PM

13−

16+

14−type Expr =

17+

15− General.Expr () Def Var.Canonical Type.Canonical

18+data Expr

16−

19+ = Literal Literal.Literal

17−

20+ | Var Var.Canonical

18−type Expr' =

21+ | Range Expr Expr

19− General.Expr' () Def Var.Canonical Type.Canonical

22+ | ExplicitList [Expr]

23+ | Binop Var.Canonical Expr Expr

24+ | Function [String] Expr

25+ | Call Expr [Expr]

26+ | TailCall String [String] [Expr]

27+ | If [(Expr, Expr)] Expr

28+ | Let [Def] Expr

29+ | Case Expr (PM.DecisionTree Int) (Map.Map Int Expr)

30+ | Data String [Expr]

31+ | DataAccess Expr Int

32+ | Access Expr String

33+ | Update Expr [(String, Expr)]

34+ | Record [(String, Expr)]

35+ | Port (General.PortImpl Expr Type.Canonical)

36+ | GLShader String String Literal.GLShaderTipe

37+ | Crash

22data Def

40data Def

23− = Definition Facts Pattern.Optimized Expr

41+ = Def Facts String Expr

24− deriving (Show)

42+ | TailDef Facts String [String] Expr

27data Facts = Facts

45data Facts = Facts

28− { tailRecursionDetails :: Maybe String

46+ { home :: Maybe ModuleName.Canonical

29 , dependencies :: [Var.TopLevel]

47 , dependencies :: [Var.TopLevel]

30 }

48 }

31− deriving (Show)

32−

33−

34−dummyFacts :: Facts

35−dummyFacts =

36− Facts Nothing []

src/AST/Module.hs+1−1

@@ -60,7 +60,7 @@ type CanonicalModule =

62type Optimized =

63− Module Docs.Centralized [Name.Raw] [Var.Value] (Body Optimized.Expr)

63+ [Optimized.Def]

66data Module docs imports exports body = Module

src/AST/Pattern.hs−4

@@ -38,10 +38,6 @@ type CanonicalPattern =

38 Pattern R.Region Var.Canonical

41−type Optimized =

42− Pattern () Var.Canonical

43−

44−

45list :: R.Position -> [RawPattern] -> RawPattern

41list :: R.Position -> [RawPattern] -> RawPattern

46list end patterns =

42list end patterns =

47 case patterns of

43 case patterns of

src/AST/Variable.hs+16

@@ -71,6 +71,22 @@ inCore home name =

72-- VARIABLE RECOGNIZERS

74+isLocalHome :: Home -> Bool

75+isLocalHome home =

76+ case home of

77+ BuiltIn ->

78+ False

79+

80+ Module _ ->

81+ False

82+

83+ TopLevel _ ->

84+ True

85+

86+ Local ->

87+ True

88+

89+

74is :: ModuleName.Raw -> String -> Canonical -> Bool

90is :: ModuleName.Raw -> String -> Canonical -> Bool

75is home name var =

91is home name var =

76 var == inCore home name

92 var == inCore home name

src/Generate/JavaScript.hs+78−201

@@ -5,38 +5,29 @@ import Control.Arrow (first, second, (***))

5import Control.Monad.State as State

6import qualified Data.List as List

7import qualified Data.Map as Map

8−import qualified Data.Maybe as Maybe

9import Language.ECMAScript3.PrettyPrint as ES

8import Language.ECMAScript3.PrettyPrint as ES

10import Language.ECMAScript3.Syntax

9import Language.ECMAScript3.Syntax

11import qualified Text.PrettyPrint.Leijen as PP

10import qualified Text.PrettyPrint.Leijen as PP

13−import AST.Expression.General as Expr

12+import qualified AST.Expression.General as Expr

14−import qualified AST.Expression.Optimized as Opt

13+import AST.Expression.Optimized as Opt

15−import qualified AST.Helpers as Help

16import AST.Literal

14import AST.Literal

17import qualified AST.Module as Module

15import qualified AST.Module as Module

18import qualified AST.Module.Name as ModuleName

16import qualified AST.Module.Name as ModuleName

19−import qualified AST.Pattern as P

20import qualified AST.Variable as Var

17import qualified AST.Variable as Var

21import Generate.JavaScript.Helpers as Help

18import Generate.JavaScript.Helpers as Help

22import qualified Generate.JavaScript.BuiltIn as BuiltIn

19import qualified Generate.JavaScript.BuiltIn as BuiltIn

23−import qualified Generate.JavaScript.Crash as Crash

24import qualified Generate.JavaScript.Literal as Literal

20import qualified Generate.JavaScript.Literal as Literal

25import qualified Generate.JavaScript.Port as Port

21import qualified Generate.JavaScript.Port as Port

26import qualified Generate.JavaScript.Variable as Var

22import qualified Generate.JavaScript.Variable as Var

27−import qualified Optimize.Cases as Case

23+import qualified Optimize.Cases as PM

28−import qualified Reporting.Annotation as A

29−import qualified Reporting.Crash as Crash

32generate :: Module.Optimized -> String

26generate :: Module.Optimized -> String

33−generate module_ =

27+generate definitions =

34 let

28 let

35− (definitions, _) =

36− flattenLets [] (Module.program (Module.body module_))

37−

38 stmts =

29 stmts =

39− concat (State.evalState (mapM defToStatements definitions) 0)

30+ State.evalState (mapM generateDef definitions) 0

40 in

31 in

41 PP.displayS (PP.renderPretty 0.4 120 (ES.prettyPrint stmts)) ""

32 PP.displayS (PP.renderPretty 0.4 120 (ES.prettyPrint stmts)) ""

@@ -122,7 +113,7 @@ exprToJsExpr tcc canonicalExpr =

122

113

123

114

124exprToCode :: TailCallContext -> Opt.Expr -> State Int Code

115exprToCode :: TailCallContext -> Opt.Expr -> State Int Code

125−exprToCode tcc annotatedExpr@(A.A _ expr) =

116+exprToCode tcc expr =

126 case expr of

117 case expr of

127 Var var ->

118 Var var ->

128 jsExpr $ Var.canonical var

119 jsExpr $ Var.canonical var

@@ -172,11 +163,33 @@ exprToCode tcc annotatedExpr@(A.A _ expr) =

172 Binop op leftExpr rightExpr ->

163 Binop op leftExpr rightExpr ->

173 binop op leftExpr rightExpr

164 binop op leftExpr rightExpr

174

165

175− Lambda _ _ ->

166+ Function args body ->

176− generateFunction (Expr.collectLambdas annotatedExpr)

167+ generateFunction args body

177

168

178− App _ _ ->

169+ Call func args ->

179− generateApplication tcc annotatedExpr

170+ let

171+ arity = length args

172+ aN = "A" ++ show arity

173+ in

174+ do jsFunc <- toJsExpr func

175+ jsArgs <- mapM toJsExpr args

176+ jsExpr $

177+ if 2 <= arity && arity <= 9 then

178+ ref aN `call` (jsFunc:jsArgs)

179+ else

180+ foldl1 (<|) (jsFunc:jsArgs)

181+

182+ TailCall name argNames args ->

183+ let

184+ reassign name tempName =

185+ ExprStmt () (AssignExpr () OpAssign (LVar () name) (ref tempName))

186+ in

187+ do args' <- mapM toJsExpr args

188+ tempNames <- mapM (\_ -> Var.fresh) args

189+ jsBlock $

190+ VarDeclStmt () (zipWith varDecl tempNames args')

191+ : zipWith reassign argNames tempNames

192+ ++ [ContinueStmt () (Just (Id () name))]

180

193

181 Let defs body ->

194 Let defs body ->

182 generateLet tcc defs body

195 generateLet tcc defs body

@@ -184,8 +197,8 @@ exprToCode tcc annotatedExpr@(A.A _ expr) =

184 If branches finally ->

197 If branches finally ->

185 generateIf tcc branches finally

198 generateIf tcc branches finally

186

199

187− Case expr branches ->

200+ Case expr decisionTree branches ->

188− generateCase tcc expr branches

201+ generateCase tcc expr decisionTree branches

189

202

190 ExplicitList elements ->

203 ExplicitList elements ->

191 do jsElements <- mapM toJsExpr elements

204 do jsElements <- mapM toJsExpr elements

@@ -199,43 +212,45 @@ exprToCode tcc annotatedExpr@(A.A _ expr) =

199 fields =

212 fields =

200 zipWith (\n e -> (prop ("_" ++ show n), e)) [ 0 :: Int .. ]

213 zipWith (\n e -> (prop ("_" ++ show n), e)) [ 0 :: Int .. ]

201

214

215+ DataAccess dataExpr index ->

216+ do jsDataExpr <- toJsExpr dataExpr

217+ jsExpr $ DotRef () jsDataExpr (var ("_" ++ show index))

218+

202 GLShader _uid src _tipe ->

219 GLShader _uid src _tipe ->

203 jsExpr $ ObjectLit () [(PropString () "src", Literal.literal (Str src))]

220 jsExpr $ ObjectLit () [(PropString () "src", Literal.literal (Str src))]

204

221

205 Port impl ->

222 Port impl ->

206 case impl of

223 case impl of

207− In name portType ->

224+ Expr.In name portType ->

208 jsExpr (Port.inbound name portType)

225 jsExpr (Port.inbound name portType)

209

226

210− Out name expr portType ->

227+ Expr.Out name expr portType ->

211 do expr' <- toJsExpr expr

228 do expr' <- toJsExpr expr

212 jsExpr (Port.outbound name expr' portType)

229 jsExpr (Port.outbound name expr' portType)

213

230

214− Task name expr portType ->

231+ Expr.Task name expr portType ->

215 do expr' <- toJsExpr expr

232 do expr' <- toJsExpr expr

216 jsExpr (Port.task name expr' portType)

233 jsExpr (Port.task name expr' portType)

217

234

218− Crash details ->

235+ Crash ->

219− jsExpr $ Crash.crash details

236+ error "TODO"

220

237

221

238

222-- FUNCTIONS

239-- FUNCTIONS

223

240

224−generateFunction :: ([P.Optimized], Opt.Expr) -> State Int Code

241+generateFunction :: [String] -> Opt.Expr -> State Int Code

225−generateFunction (args, initialBody) =

242+generateFunction args body =

226− do (argVars, patternDefs) <- destructuredArgs args

243+ do code <- exprToCode Nothing body

227− code <- generateLet Nothing patternDefs initialBody

228− jsExpr (generateFunctionWithArity argVars code)

244+ jsExpr (generateFunctionWithArity args code)

229

245

230

246

231−generateTailFunction :: String -> ([P.Optimized], Opt.Expr) -> State Int (Expression ())

247+generateTailFunction :: String -> [String] -> Opt.Expr -> State Int (Expression ())

232−generateTailFunction name (args, initialBody) =

248+generateTailFunction name args body =

233− do (argVars, patternDefs) <- destructuredArgs args

249+ do code <- exprToCode Nothing body

234− label <- Id () <$> Var.fresh

250+ return $ generateFunctionWithArity args $ JsBlock $ (:[]) $

235− code <- generateLet (Just (name, argVars, label)) patternDefs initialBody

251+ LabelledStmt ()

236− let whileLoop =

252+ (Id () name)

237− JsBlock [ LabelledStmt () label (WhileStmt () (BoolLit () True) (toStatement code)) ]

253+ (WhileStmt () (BoolLit () True) (toStatement code))

238− return (generateFunctionWithArity argVars whileLoop)

239

254

240

255

241generateFunctionWithArity :: [String] -> Code -> Expression ()

256generateFunctionWithArity :: [String] -> Code -> Expression ()

@@ -256,81 +271,6 @@ generateFunctionWithArity args code =

256 foldl (\body arg -> function [arg] [ret body]) innerBody otherArgs

271 foldl (\body arg -> function [arg] [ret body]) innerBody otherArgs

257

272

258

273

259−destructuredArgs :: [P.Optimized] -> State Int ([String], [Opt.Def])

260−destructuredArgs args =

261− do (argVars, maybePatternDefs) <- unzip <$> mapM destructPattern args

262− return (argVars, Maybe.catMaybes maybePatternDefs)

263−

264−

265−destructPattern :: P.Optimized -> State Int (String, Maybe Opt.Def)

266−destructPattern pattern@(A.A ann pat) =

267− case pat of

268− P.Var x ->

269− return (Var.safe x, Nothing)

270−

271− _ ->

272− do arg <- Var.fresh

273− return

274− ( arg

275− , Just $ Opt.Definition Opt.dummyFacts pattern (A.A ann (localVar arg))

276− )

277−

278−

279−-- APPLICATIONS

280−

281−generateApplication :: TailCallContext -> Opt.Expr -> State Int Code

282−generateApplication tcc expr =

283− let

284− (func:args) =

285− Expr.collectApps expr

286−

287− arity =

288− length args

289−

290− reassign name tempName =

291− ExprStmt () (AssignExpr () OpAssign (LVar () name) (ref tempName))

292−

293− aN =

294− "A" ++ show arity

295− in

296− case isTailCall tcc func arity of

297− Just (argNames, label) ->

298− do args' <- mapM toJsExpr args

299− tempNames <- mapM (\_ -> Var.fresh) args

300− jsBlock $

301− VarDeclStmt () (zipWith varDecl tempNames args')

302− : zipWith reassign argNames tempNames

303− ++ [ContinueStmt () (Just label)]

304−

305− _ ->

306− do func' <- toJsExpr func

307− args' <- mapM toJsExpr args

308− jsExpr $

309− if 2 <= arity && arity <= 9 then

310− ref aN `call` (func':args')

311− else

312− foldl1 (<|) (func':args')

313−

314−

315−isTailCall :: TailCallContext -> Opt.Expr -> Int -> Maybe ([String], Label)

316−isTailCall tcc (A.A _ func) arity =

317− case (func, tcc) of

318− (Var (Var.Canonical Var.Local name), Just (tcName, tcArgs, tcLabel)) ->

319− if name == tcName && length tcArgs == arity then

320− Just (tcArgs, tcLabel)

321− else

322− Nothing

323−

324− (Var (Var.Canonical (Var.TopLevel _) name), Just (tcName, tcArgs, tcLabel)) ->

325− if name == tcName && length tcArgs == arity then

326− Just (tcArgs, tcLabel)

327− else

328− Nothing

329−

330− _ ->

331− Nothing

332−

333−

334-- LET EXPRESSIONS

274-- LET EXPRESSIONS

335

275

336generateLet

276generateLet

@@ -338,20 +278,12 @@ generateLet

338 -> [Opt.Def]

278 -> [Opt.Def]

339 -> Opt.Expr

279 -> Opt.Expr

340 -> State Int Code

280 -> State Int Code

341−generateLet tcc givenDefs givenBody =

281+generateLet tcc defs body =

342− do let (defs, body) = flattenLets givenDefs givenBody

343− stmts <- concat <$> mapM defToStatements defs

282+ do stmts <- mapM generateDef defs

344 code <- exprToCode tcc body

283 code <- exprToCode tcc body

345 jsBlock (stmts ++ toStatementList code)

284 jsBlock (stmts ++ toStatementList code)

346

285

347

286

348−flattenLets :: [Opt.Def] -> Opt.Expr -> ([Opt.Def], Opt.Expr)

349−flattenLets defs lexpr@(A.A _ expr) =

350− case expr of

351− Let ds body -> flattenLets (defs ++ ds) body

352− _ -> (defs, lexpr)

353−

354−

355-- GENERATE IFS

287-- GENERATE IFS

356

288

357generateIf :: TailCallContext -> [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> State Int Code

289generateIf :: TailCallContext -> [(Opt.Expr, Opt.Expr)] -> Opt.Expr -> State Int Code

@@ -396,13 +328,13 @@ crushIfsHelp visitedBranches unvisitedBranches finally =

396 case unvisitedBranches of

328 case unvisitedBranches of

397 [] ->

329 [] ->

398 case finally of

330 case finally of

399− A.A _ (If subBranches subFinally) ->

331+ If subBranches subFinally ->

400 crushIfsHelp visitedBranches subBranches subFinally

332 crushIfsHelp visitedBranches subBranches subFinally

401

333

402 _ ->

334 _ ->

403 (reverse visitedBranches, finally)

335 (reverse visitedBranches, finally)

404

336

405− (A.A _ (Literal (Boolean True)), branch) : _ ->

337+ (Literal (Boolean True), branch) : _ ->

406 crushIfsHelp visitedBranches [] branch

338 crushIfsHelp visitedBranches [] branch

407

339

408 visiting : unvisited ->

340 visiting : unvisited ->

@@ -412,84 +344,29 @@ crushIfsHelp visitedBranches unvisitedBranches finally =

412

344

413-- DEFINITIONS

345-- DEFINITIONS

414

346

415−defToStatements :: Opt.Def -> State Int [Statement ()]

347+generateDef :: Opt.Def -> State Int (Statement ())

416−defToStatements (Opt.Definition facts pattern expr) =

348+generateDef def =

417− case Opt.tailRecursionDetails facts of

349+ do (home, name, jsBody) <-

418− Just name ->

350+ case def of

351+ Opt.TailDef (Opt.Facts home _) name argNames body ->

419− do func <- generateTailFunction name (Expr.collectLambdas expr)

352+ (,,) home name <$> generateTailFunction name argNames body

420− return [ VarDeclStmt () [ varDecl name func ] ]

421−

422− Nothing ->

423− defToStatementsHelp facts pattern =<< toJsExpr expr

424

353

354+ Opt.Def (Opt.Facts home _) name body ->

355+ (,,) home name <$> toJsExpr body

425

356

426−defToStatementsHelp

357+ return (VarDeclStmt () [ varDecl (Var.defName home name) jsBody ])

427− :: Opt.Facts

428− -> P.Optimized

429− -> Expression ()

430− -> State Int [Statement ()]

431−defToStatementsHelp facts annPattern@(A.A _ pattern) jsExpr =

432− let

433− define x =

434− varDecl x jsExpr

435− in

436− case pattern of

437− P.Var x ->

438− if Help.isOp x then

439− let

440− op = LBracket () (ref "_op") (string x)

441− in

442− return [ ExprStmt () $ AssignExpr () OpAssign op jsExpr ]

443− else

444− return [ VarDeclStmt () [ define (Var.safe x) ] ]

445−

446− P.Record fields ->

447− let

448− setField name =

449− varDecl name (obj ["$",name])

450− in

451− return [ VarDeclStmt () (define "$" : map setField fields) ]

452−

453− P.Data (Var.Canonical _ name) patterns | vars /= Nothing ->

454− return [ VarDeclStmt () (setup (zipWith decl (maybe [] id vars) [0..])) ]

455− where

456− vars = getVars patterns

457− getVars patterns =

458− case patterns of

459− A.A _ (P.Var x) : rest ->

460− (Var.safe x :) `fmap` getVars rest

461− [] ->

462− Just []

463− _ ->

464− Nothing

465−

466− decl x n = varDecl x (obj ["$","_" ++ show n])

467− setup vars

468− | Help.isTuple name = define "$" : vars

469− | otherwise = define "_raw" : safeAssign : vars

470−

471− safeAssign = varDecl "$" (CondExpr () if' (ref "_raw") exception)

472− if' = InfixExpr () OpStrictEq (obj ["_raw","ctor"]) (string name)

473− exception = Crash.crash (Crash.IncompletePatternMatch (error "TODO"))

474−

475− _ ->

476− do defs' <- concat <$> mapM toDef vars

477− return (VarDeclStmt () [define "_"] : defs')

478− where

479− vars = P.boundVarList annPattern

480− mkVar = A.A () . localVar

481− toDef y =

482− let expr = A.A () $ Case (mkVar "_") [(annPattern, mkVar y)]

483− pat = A.A () (P.Var y)

484− in

485− defToStatements (Opt.Definition facts pat expr)

486

358

487

359

488-- CASE EXPRESSIONS

360-- CASE EXPRESSIONS

489

361

490−generateCase :: TailCallContext -> Opt.Expr -> [(P.Optimized, Opt.Expr)] -> State Int Code

362+generateCase

363+ :: TailCallContext

364+ -> Opt.Expr

365+ -> PM.DecisionTree Int

366+ -> Map.Map Int Opt.Expr

367+ -> State Int Code

491−generateCase tcc expr branches =

368+generateCase tcc expr decisionTree branches =

492− error "TODO" tcc expr branches

369+ error "TODO" tcc expr decisionTree branches

493

370

494

371

495-- BINARY OPERATORS

372-- BINARY OPERATORS

@@ -501,7 +378,7 @@ binop

501 -> State Int Code

378 -> State Int Code

502binop func left right

379binop func left right

503 | func == Var.Canonical Var.BuiltIn "::" =

380 | func == Var.Canonical Var.BuiltIn "::" =

504− toCode (A.A () (Data "::" [left,right]))

381+ toCode (Data "::" [left,right])

505

382

506 | func == forwardCompose =

383 | func == forwardCompose =

507 compose (collectLeftAssoc forwardCompose left right)

384 compose (collectLeftAssoc forwardCompose left right)

@@ -629,7 +506,7 @@ collectRightAssoc desiredOp left right =

629collectRightAssocHelp :: Var.Canonical -> [Opt.Expr] -> Opt.Expr -> [Opt.Expr]

506collectRightAssocHelp :: Var.Canonical -> [Opt.Expr] -> Opt.Expr -> [Opt.Expr]

630collectRightAssocHelp desiredOp exprList expr =

507collectRightAssocHelp desiredOp exprList expr =

631 case expr of

508 case expr of

632− A.A _ (Binop op left right) | op == desiredOp ->

509+ Binop op left right | op == desiredOp ->

633 collectRightAssocHelp desiredOp (left : exprList) right

510 collectRightAssocHelp desiredOp (left : exprList) right

634

511

635 _ ->

512 _ ->

@@ -645,7 +522,7 @@ collectLeftAssoc desiredOp left right =

645collectLeftAssocHelp :: Var.Canonical -> [Opt.Expr] -> Opt.Expr -> [Opt.Expr]

522collectLeftAssocHelp :: Var.Canonical -> [Opt.Expr] -> Opt.Expr -> [Opt.Expr]

646collectLeftAssocHelp desiredOp exprList expr =

523collectLeftAssocHelp desiredOp exprList expr =

647 case expr of

524 case expr of

648− A.A _ (Binop op left right) | op == desiredOp ->

525+ Binop op left right | op == desiredOp ->

649 collectLeftAssocHelp desiredOp (right : exprList) left

526 collectLeftAssocHelp desiredOp (right : exprList) left

650

527

651 _ ->

528 _ ->

src/Generate/JavaScript/Variable.hs+18−6

@@ -1,4 +1,4 @@

1−module Generate.JavaScript.Variable (fresh, canonical, safe) where

1+module Generate.JavaScript.Variable (fresh, canonical, defName, safe) where

3import qualified Control.Monad.State as State

4import qualified Data.List as List

@@ -21,6 +21,18 @@ fresh =

21 return ("_v" ++ show n)

24+-- DEF NAMES

25+

26+defName :: Maybe ModuleName.Canonical -> String -> String

27+defName maybeHome name =

28+ case maybeHome of

29+ Nothing ->

30+ safe name

31+

32+ Just home ->

33+ canonicalPrefix home (safe name)

34+

35+

24-- INSTANTIATE VARIABLES

36-- INSTANTIATE VARIABLES

26canonical :: Var.Canonical -> JS.Expression ()

38canonical :: Var.Canonical -> JS.Expression ()

@@ -39,21 +51,21 @@ addRoot home name =

39 name

51 name

41 Var.TopLevel moduleName ->

53 Var.TopLevel moduleName ->

42− canonicalName moduleName name

54+ canonicalPrefix moduleName name

44 Var.BuiltIn ->

56 Var.BuiltIn ->

45 name

57 name

47 Var.Module moduleName ->

59 Var.Module moduleName ->

48− canonicalName moduleName name

60+ canonicalPrefix moduleName name

51−canonicalName :: ModuleName.Canonical -> String -> String

63+canonicalPrefix :: ModuleName.Canonical -> String -> String

52−canonicalName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =

64+canonicalPrefix (ModuleName.Canonical (Pkg.Name user project) moduleName) name =

53 map (swap '-' '_') user

65 map (swap '-' '_') user

54 ++ '$' : map (swap '-' '_') project

66 ++ '$' : map (swap '-' '_') project

55 ++ '$' : List.intercalate "$" moduleName

67 ++ '$' : List.intercalate "$" moduleName

56− ++ '$' : name

68+ ++ '$' : safe name

59swap :: Char -> Char -> Char -> Char

71swap :: Char -> Char -> Char -> Char

src/Optimize.hs+2−12

@@ -5,15 +5,5 @@ import qualified Optimize.TailCalls as TC

7optimize :: M.CanonicalModule -> M.Optimized

8−optimize modul =

8+optimize =

9− let

10− canonicalBody =

11− M.body modul

12−

13− optimizedProgram =

14− TC.optimize (M.program canonicalBody)

9+ TC.optimize

15−

16− optimizedBody =

17− canonicalBody { M.program = optimizedProgram }

18− in

19− modul { M.body = optimizedBody }

src/Optimize/Cases.hs+18−26

@@ -1,3 +1,4 @@

1+{-# OPTIONS_GHC -Wall #-}

1module Optimize.Cases where

2module Optimize.Cases where

2{- To learn more about how this works, definitely read through:

3{- To learn more about how this works, definitely read through:

@@ -10,7 +11,6 @@ explains this extraordinarily well! We are currently using the same heuristics

10as SML/NJ to get nice trees.

11as SML/NJ to get nice trees.

11-}

12-}

13−

14import Control.Arrow (second)

15import Data.Function (on)

16import qualified Data.List as List

@@ -18,13 +18,15 @@ import qualified Data.Map as Map

18import Data.Map ((!))

19import qualified Data.Maybe as Maybe

21−import qualified AST.Expression.Optimized as Opt

22import qualified AST.Literal as L

21import qualified AST.Literal as L

23import qualified AST.Pattern as P

22import qualified AST.Pattern as P

24import qualified AST.Variable as Var

23import qualified AST.Variable as Var

25import qualified Reporting.Annotation as A

24import qualified Reporting.Annotation as A

27+type CPattern = P.CanonicalPattern

28+

29+

28-- COMPILE CASES

30-- COMPILE CASES

30{-| Users of this module will mainly interact with this function. It takes

32{-| Users of this module will mainly interact with this function. It takes

@@ -36,23 +38,13 @@ If 2 or more leaves point to the same label, we need to do some tricks in JS to

36make that work nicely. When is JS getting goto?! ;) That is outside the scope

38make that work nicely. When is JS getting goto?! ;) That is outside the scope

37of this module though.

39of this module though.

38-}

40-}

39−compile

40− :: VariantDict

41+compile :: VariantDict -> [(CPattern, Int)] -> DecisionTree Int

41− -> [(P.Optimized, Opt.Expr)]

42− -> (DecisionTree Int, Map.Map Int Opt.Expr)

43compile variantDict rawBranches =

42compile variantDict rawBranches =

44 let

43 let

45− format index (pattern, expr) =

44+ format (pattern, index) =

46− ( Branch index [(Empty, pattern)]

45+ Branch index [(Empty, pattern)]

47− , (index, expr)

48− )

49−

50− (branches, resultList) =

51− unzip (zipWith format [0..] rawBranches)

52 in

46 in

53− ( toDecisionTree variantDict branches

47+ toDecisionTree variantDict (map format rawBranches)

54− , Map.fromList resultList

55− )

58{-| When a certain union type is defined, you specify a certain number of tags.

50{-| When a certain union type is defined, you specify a certain number of tags.

@@ -81,8 +73,8 @@ data DecisionTree a

81 , _default :: Maybe (DecisionTree a)

73 , _default :: Maybe (DecisionTree a)

82 }

74 }

83 | Match

75 | Match

84− { result :: a

76+ { _result :: a

85− , substitutions :: Map.Map String Path

77+ , _substitutions :: Map.Map String Path

86 }

78 }

@@ -118,7 +110,7 @@ add path finalLink =

118 Field name (add subpath finalLink)

110 Field name (add subpath finalLink)

119

111

120

112

121−subPositions :: Path -> [P.Optimized] -> [(Path, P.Optimized)]

113+subPositions :: Path -> [CPattern] -> [(Path, CPattern)]

122subPositions path patterns =

114subPositions path patterns =

123 zipWith

115 zipWith

124 (\index pattern -> (add path (Position index Empty), pattern))

116 (\index pattern -> (add path (Position index Empty), pattern))

@@ -131,7 +123,7 @@ subPositions path patterns =

131data Branch =

123data Branch =

132 Branch

124 Branch

133 { _goal :: Int

125 { _goal :: Int

134− , _patterns :: [(Path, P.Optimized)]

126+ , _patterns :: [(Path, CPattern)]

135 }

127 }

136

128

137

129

@@ -205,7 +197,7 @@ flattenPatterns variantDict (Branch goal pathPatterns) =

205 Branch goal (concatMap (flatten variantDict) pathPatterns)

197 Branch goal (concatMap (flatten variantDict) pathPatterns)

206

198

207

199

208−flatten :: VariantDict -> (Path, P.Optimized) -> [(Path, P.Optimized)]

200+flatten :: VariantDict -> (Path, CPattern) -> [(Path, CPattern)]

209flatten variantDict pathPattern@(path, A.A ann pattern) =

201flatten variantDict pathPattern@(path, A.A ann pattern) =

210 case pattern of

202 case pattern of

211 P.Var _ ->

203 P.Var _ ->

@@ -251,7 +243,7 @@ checkForMatch branches =

251 Nothing

243 Nothing

252

244

253

245

254−getSubstitution :: (Path, P.Optimized) -> Maybe [(String, Path)]

246+getSubstitution :: (Path, CPattern) -> Maybe [(String, Path)]

255getSubstitution (path, A.A _ pattern) =

247getSubstitution (path, A.A _ pattern) =

256 case pattern of

248 case pattern of

257 P.Var x ->

249 P.Var x ->

@@ -336,8 +328,8 @@ toRelevantBranch test path branch@(Branch goal pathPatterns) =

336

328

337extract

329extract

338 :: Path

330 :: Path

339− -> [(Path, P.Optimized)]

331+ -> [(Path, CPattern)]

340− -> Maybe ([(Path, P.Optimized)], P.Optimized, [(Path, P.Optimized)])

332+ -> Maybe ([(Path, CPattern)], CPattern, [(Path, CPattern)])

341extract selectedPath pathPatterns =

333extract selectedPath pathPatterns =

342 case pathPatterns of

334 case pathPatterns of

343 [] ->

335 [] ->

@@ -368,7 +360,7 @@ isIrrelevantTo selectedPath (Branch _ pathPatterns) =

368 not (needsTests pattern)

360 not (needsTests pattern)

369

361

370

362

371−needsTests :: P.Optimized -> Bool

363+needsTests :: CPattern -> Bool

372needsTests (A.A _ pattern) =

364needsTests (A.A _ pattern) =

373 case pattern of

365 case pattern of

374 P.Var _ ->

366 P.Var _ ->

@@ -404,7 +396,7 @@ smallDefaults branches =

404 fst (List.minimumBy (compare `on` snd) weightedPaths)

396 fst (List.minimumBy (compare `on` snd) weightedPaths)

405

397

406

398

407−isChoicePath :: (Path, P.Optimized) -> Maybe Path

399+isChoicePath :: (Path, CPattern) -> Maybe Path

408isChoicePath (path, pattern) =

400isChoicePath (path, pattern) =

409 if needsTests pattern then

401 if needsTests pattern then

410 Just path

402 Just path

src/Optimize/TailCalls.hs+284−129

@@ -1,46 +1,64 @@

1−module Optimize.TailCalls where

1+module Optimize.TailCalls (optimize) where

3import Control.Applicative

4−import Control.Arrow (first)

5import qualified Control.Monad as M

4import qualified Control.Monad as M

6−import qualified Data.List as List

5+import qualified Control.Monad.State as State

6+import qualified Data.Map as Map

7import qualified Data.Traversable as T

9−import AST.Expression.General as Expr

9+import qualified AST.Expression.General as Expr

10import qualified AST.Expression.Canonical as Can

11import qualified AST.Expression.Optimized as Opt

12+import qualified AST.Module as Module

13+import qualified AST.Module.Name as ModuleName

12import qualified AST.Pattern as P

14import qualified AST.Pattern as P

13import qualified AST.Variable as Var

15import qualified AST.Variable as Var

16+import qualified Optimize.Cases as Cases

14import qualified Reporting.Annotation as A

17import qualified Reporting.Annotation as A

17-- OPTIMIZE FOR TAIL CALLS

20-- OPTIMIZE FOR TAIL CALLS

19−optimize :: Can.Expr -> Opt.Expr

22+optimize :: Module.CanonicalModule -> Module.Optimized

20−optimize expression =

23+optimize module_ =

21− let

24+ let

22− (Result _ optExpr) =

25+ home =

23− findTailCalls Nothing expression

26+ Module.name module_

27+

28+ (defs, _) =

29+ flattenLets [] (Module.program (Module.body module_))

24− in

30+ in

25− optExpr

31+ State.evalState

32+ (concat <$> mapM (definition (Just home)) defs)

33+ (Env False 0)

28−-- TRACKER TO THREAD FINDINGS THROUGH TRAVERSAL

36+flattenLets :: [Can.Def] -> Can.Expr -> ([Can.Def], Can.Expr)

37+flattenLets defs annExpr@(A.A _ expr) =

38+ case expr of

39+ Expr.Let ds body ->

40+ flattenLets (defs ++ ds) body

41+

42+ _ ->

43+ (defs, annExpr)

44+

30−data Result a = Result Bool a

46+-- TRACKER TO THREAD FINDINGS THROUGH TRAVERSAL

48+type Optimizer a =

49+ State.State Env a

33−instance M.Functor Result where

34− fmap func (Result hasTailCall value) =

35− Result hasTailCall (func value)

52+data Env = Env

53+ { _hasTailCall :: Bool

54+ , _uid :: Int

55+ }

38−instance Applicative Result where

39− pure value =

40− Result False value

42− (<*>) (Result hasTailCall func) (Result hasTailCall' value) =

58+setTailCall :: Bool -> Optimizer ()

43− Result (hasTailCall || hasTailCall') (func value)

59+setTailCall bool =

60+ do uid <- State.gets _uid

61+ State.put (Env bool uid)

46mapSnd :: M.Functor box => (a -> box b) -> (x, a) -> box (x, b)

64mapSnd :: M.Functor box => (a -> box b) -> (x, a) -> box (x, b)

@@ -50,45 +68,132 @@ mapSnd func (x, a) =

51-- CONVERT DEFINITIONS

69-- CONVERT DEFINITIONS

53−detectTailRecursion :: Can.Def -> Opt.Def

71+definition :: Maybe ModuleName.Canonical -> Can.Def -> Optimizer [Opt.Def]

54−detectTailRecursion (Can.Definition canonFacts pattern expression _) =

72+definition home (Can.Definition (Can.Facts deps) pattern@(A.A _ ptrn) expression _) =

55− let

73+ let

56− (args, body) =

74+ (args, rawBody) =

57− Expr.collectLambdas expression

75+ Expr.collectLambdas expression

76+ in

77+ case (ptrn, args) of

78+ (P.Var name, _ : _) ->

79+

80+ do (Env htc uid) <- State.get

81+ State.put (Env False uid)

82+

83+ (args, body) <- optimizeFunction (Just name) args rawBody

84+

85+ (Env isTailCall uid') <- State.get

86+ State.put (Env htc uid')

87+

88+ let facts = Opt.Facts home deps

59− context :: Context

90+ return $

60− context =

91+ if isTailCall then

61− case (pattern, args) of

62− -- detect if it is a function

63− (A.A _ (P.Var name), _ : _) ->

64− Just (name, length args)

66− _ ->

93+ [ Opt.TailDef facts name args body ]

67− Nothing

69− (Result isTailCall optExpr) =

95+ else

70− findTailCalls context body

72− lambda x e =

97+ [ Opt.Def facts name (Opt.Function args body) ]

73− A.A () (Lambda x e)

75− facts =

99+ (P.Var name, []) ->

76− Opt.Facts

100+

77− (if isTailCall then fmap fst context else Nothing)

101+ do hasTailCall <- State.gets _hasTailCall

78− (Can.dependencies canonFacts)

102+ body <- findTailCalls Nothing rawBody

103+ setTailCall hasTailCall

104+ return [ Opt.Def (Opt.Facts home deps) name body ]

105+

106+ (_, []) ->

107+

108+ do name <- freshName

109+ optBody <- findTailCalls Nothing rawBody

110+ let optDef = Opt.Def (Opt.Facts home deps) name optBody

111+ return (optDef : patternToDefs home name pattern)

112+

113+ _ ->

114+ error "there should never be a function where the name is not a P.Var"

115+

116+

117+-- OPTIMIZE FUNCTION

118+

119+optimizeFunction

120+ :: Maybe String

121+ -> [P.CanonicalPattern]

122+ -> Can.Expr

123+ -> Optimizer ([String], Opt.Expr)

124+optimizeFunction maybeName patterns givenBody =

125+ do (argNames, body) <- M.foldM depatternArgs ([], givenBody) (reverse patterns)

126+ optBody <- findTailCalls (makeContext argNames =<< maybeName) body

127+ return (argNames, optBody)

128+

129+

130+makeContext :: [String] -> String -> Context

131+makeContext argNames name =

132+ Just (name, length argNames, argNames)

133+

134+

135+depatternArgs

136+ :: ([String], Can.Expr)

137+ -> P.CanonicalPattern

138+ -> Optimizer ([String], Can.Expr)

139+depatternArgs (names, rawExpr) ptrn =

140+ do (name, expr) <- depattern ptrn rawExpr

141+ return (name : names, expr)

142+

143+

144+patternToDefs

145+ :: Maybe ModuleName.Canonical

146+ -> String

147+ -> P.CanonicalPattern

148+ -> [Opt.Def]

149+patternToDefs home rootName pattern =

150+ let

151+ (deps, rootExpr) =

152+ case home of

153+ Nothing ->

154+ ( []

155+ , Opt.Var (Var.local rootName)

156+ )

157+

158+ Just moduleName ->

159+ ( [ Var.TopLevelVar moduleName rootName ]

160+ , Opt.Var (Var.topLevel moduleName rootName)

161+ )

162+

163+ toDef (name, accessExpr) =

164+ Opt.Def (Opt.Facts home deps) name accessExpr

79 in

165 in

80− Opt.Definition

166+ map toDef (substitutions rootExpr pattern)

81− facts

167+

82− (removeAnnotations pattern)

168+

83− (foldr lambda optExpr (map removeAnnotations args))

169+substitutions :: Opt.Expr -> P.CanonicalPattern -> [(String, Opt.Expr)]

170+substitutions expr (A.A _ pattern) =

171+ case pattern of

172+ P.Var name ->

173+ [ (name, expr) ]

174+

175+ P.Literal _ ->

176+ []

177+

178+ P.Record fields ->

179+ map (\name -> (name, Opt.Access expr name)) fields

180+

181+ P.Anything ->

182+ []

183+

184+ P.Alias alias realPattern ->

185+ (alias, expr) : substitutions expr realPattern

186+

187+ P.Data _ patterns ->

188+ concat (zipWith (substitutions . Opt.DataAccess expr) [0..] patterns)

189

190

86-- CONVERT EXPRESSIONS

191-- CONVERT EXPRESSIONS

192

88−type Context = Maybe (String, Int)

193+type Context = Maybe (String, Int, [String])

194

195

91−findTailCalls :: Context -> Can.Expr -> Result Opt.Expr

196+findTailCalls :: Context -> Can.Expr -> Optimizer Opt.Expr

92findTailCalls context annExpr@(A.A _ expression) =

197findTailCalls context annExpr@(A.A _ expression) =

93 let

198 let

94 keepLooking =

199 keepLooking =

@@ -101,135 +206,185 @@ findTailCalls context annExpr@(A.A _ expression) =

101 -- this will never find tail calls, use this when you are working with

206 -- this will never find tail calls, use this when you are working with

102 -- expressions that cannot be turned into tail calls

207 -- expressions that cannot be turned into tail calls

103 in

208 in

104− A.A () <$>

105 case expression of

209 case expression of

106− Literal lit ->

210+ Expr.Literal lit ->

107− pure (Literal lit)

211+ pure (Opt.Literal lit)

108

212

109− Var name ->

213+ Expr.Var name ->

110− pure (Var name)

214+ pure (Opt.Var name)

111

215

112− Range lowExpr highExpr ->

216+ Expr.Range lowExpr highExpr ->

113− Range

217+ Opt.Range

114 <$> justConvert lowExpr

218 <$> justConvert lowExpr

115 <*> justConvert highExpr

219 <*> justConvert highExpr

116

220

117− ExplicitList elements ->

221+ Expr.ExplicitList elements ->

118− ExplicitList

222+ Opt.ExplicitList

119 <$> T.traverse justConvert elements

223 <$> T.traverse justConvert elements

120

224

121− Binop op leftExpr rightExpr ->

225+ Expr.Binop op leftExpr rightExpr ->

122− Binop op

226+ Opt.Binop op

123 <$> justConvert leftExpr

227 <$> justConvert leftExpr

124 <*> justConvert rightExpr

228 <*> justConvert rightExpr

125

229

126− Lambda pattern body ->

230+ Expr.Lambda _ _ ->

127− Lambda (removeAnnotations pattern) <$> justConvert body

231+ let

232+ (patterns, body) =

233+ Expr.collectLambdas annExpr

234+ in

235+ uncurry Opt.Function <$> optimizeFunction Nothing patterns body

128

236

129− App _ _ ->

237+ Expr.App _ _ ->

130 let

238 let

131 (func:args) =

239 (func:args) =

132 Expr.collectApps annExpr

240 Expr.collectApps annExpr

133−

134− isTailCall =

135− case (context, func) of

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

137− name == name' && length args == argNum

138− ( Just (name, argNum), A.A _ (Var (Var.Canonical (Var.TopLevel _) name')) ) ->

139− name == name' && length args == argNum

140− _ ->

141− False

142−

143− (Result _ (A.A _ optFunc)) =

144− justConvert func

145−

146− (Result _ optArgs) =

147− T.traverse justConvert args

148−

149− apply f arg =

150− App (A.A () f) arg

151 in

241 in

152− Result isTailCall (List.foldl' apply optFunc optArgs)

242+ case isTailCall context func (length args) of

243+ Just (name, argNames) ->

244+ do optArgs <- T.traverse justConvert args

245+ setTailCall True

246+ return (Opt.TailCall name argNames optArgs)

247+

248+ Nothing ->

249+ do hasTailCall <- State.gets _hasTailCall

250+ optFunc <- justConvert func

251+ optArgs <- T.traverse justConvert args

252+ setTailCall hasTailCall

253+ return (Opt.Call optFunc optArgs)

153

254

154

255

155− If branches finally ->

256+ Expr.If branches finally ->

156 let

257 let

157 crawlBranch (cond,branch) =

258 crawlBranch (cond,branch) =

158 (,) <$> justConvert cond <*> keepLooking branch

259 (,) <$> justConvert cond <*> keepLooking branch

159 in

260 in

160− If

261+ Opt.If

161 <$> T.traverse crawlBranch branches

262 <$> T.traverse crawlBranch branches

162 <*> keepLooking finally

263 <*> keepLooking finally

163

264

164− Let defs body ->

265+ Expr.Let defs body ->

165− let

266+ do optDefs <- concat <$> T.traverse (definition Nothing) defs

166− optDefs = map detectTailRecursion defs

167− in

168− Let optDefs <$> keepLooking body

267+ Opt.Let optDefs <$> keepLooking body

169

268

170− Case expr cases ->

269+ Expr.Case expr rawBranches ->

171 let

270 let

172− preppedCases =

271+ indexify index (pattern, branch) =

173− map (first removeAnnotations) cases

272+ ( (pattern, index)

273+ , (index, branch)

274+ )

275+

276+ (patterns, indexedBranches) =

277+ unzip (zipWith indexify [0..] rawBranches)

278+

279+ decisionTree =

280+ Cases.compile (error "need a VariantDict") patterns

281+

282+ branches =

283+ Map.fromList indexedBranches

174 in

284 in

175− Case

285+ Opt.Case

176 <$> justConvert expr

286 <$> justConvert expr

287+ <*> pure decisionTree

177− <*> T.traverse (mapSnd keepLooking) preppedCases

288+ <*> T.traverse keepLooking branches

178

289

179− Data name exprs ->

290+ Expr.Data name exprs ->

180− Data name <$> T.traverse justConvert exprs

291+ Opt.Data name <$> T.traverse justConvert exprs

181

292

182− Access record field ->

293+ Expr.Access record field ->

183− Access

294+ Opt.Access

184 <$> justConvert record

295 <$> justConvert record

185 <*> pure field

296 <*> pure field

186

297

187− Update record fields ->

298+ Expr.Update record fields ->

188− Update

299+ Opt.Update

189 <$> justConvert record

300 <$> justConvert record

190 <*> T.traverse (mapSnd justConvert) fields

301 <*> T.traverse (mapSnd justConvert) fields

191

302

192− Record fields ->

303+ Expr.Record fields ->

193− Record

304+ Opt.Record

194 <$> T.traverse (mapSnd justConvert) fields

305 <$> T.traverse (mapSnd justConvert) fields

195

306

196− GLShader uid src gltipe ->

307+ Expr.GLShader uid src gltipe ->

197− pure (GLShader uid src gltipe)

308+ pure (Opt.GLShader uid src gltipe)

198

309

199− Port impl ->

310+ Expr.Port impl ->

200− Port <$>

311+ Opt.Port <$>

201 case impl of

312 case impl of

202− In name tipe ->

313+ Expr.In name tipe ->

203− pure (In name tipe)

314+ pure (Expr.In name tipe)

315+

316+ Expr.Out name expr tipe ->

317+ (\e -> Expr.Out name e tipe) <$> justConvert expr

318+

319+ Expr.Task name expr tipe ->

320+ (\e -> Expr.Task name e tipe) <$> justConvert expr

321+

322+

323+-- DETECT TAIL CALL

324+

325+isTailCall :: Context -> Can.Expr -> Int -> Maybe (String, [String])

326+isTailCall context (A.A _ function) arity =

327+ case (context, function) of

328+ ( Just (ctxName, ctxArity, argNames), Expr.Var (Var.Canonical home name) ) ->

329+

330+ if name == ctxName && arity == ctxArity && Var.isLocalHome home then

331+ Just (name, argNames)

332+

333+ else

334+ Nothing

204

335

205− Out name expr tipe ->

336+ _ ->

206− (\e -> Out name e tipe) <$> justConvert expr

337+ Nothing

207

338

208− Task name expr tipe ->

209− (\e -> Task name e tipe) <$> justConvert expr

210

339

211− Crash details ->

212− pure (Crash details)

213

340

341+-- DEPATTERN

342+-- given a pattern and an expression, push the actual pattern matching into the

343+-- expression as a case-expression if necessary. The pattern compiler will work

344+-- it out from there

345+

346+depattern :: P.CanonicalPattern -> Can.Expr -> Optimizer (String, Can.Expr)

347+depattern canPattern@(A.A _ pattern) expr =

348+ let

349+ ann =

350+ A.A (error "the annotation added in 'depattern' should not be observed!")

351+

352+ caseExpr e branches =

353+ ann (Expr.Case e branches)

354+

355+ var name =

356+ ann (Expr.Var (Var.local name))

357+

358+ caseify =

359+ do name <- freshName

360+ return

361+ ( name

362+ , caseExpr (var name) [ (canPattern, expr) ]

363+ )

364+ in

365+ case pattern of

366+ P.Var name ->

367+ return (name, expr)

368+

369+ P.Literal _ ->

370+ caseify

214

371

215−removeAnnotations :: P.CanonicalPattern -> P.Optimized

372+ P.Record _ ->

216−removeAnnotations (A.A _ pattern) =

373+ caseify

217− A.A () $

218− case pattern of

219− P.Var x ->

220− P.Var x

221

374

222− P.Literal lit ->

375+ P.Anything ->

223− P.Literal lit

376+ do name <- freshName

377+ return (name, expr)

224

378

225− P.Record fields ->

379+ P.Alias _ _ ->

226− P.Record fields

380+ caseify

227

381

228− P.Anything ->

382+ P.Data _ _ ->

229− P.Anything

383+ caseify

230

384

231− P.Alias alias realPattern ->

232− P.Alias alias (removeAnnotations realPattern)

233

385

234− P.Data name patterns ->

386+freshName :: Optimizer String

235− P.Data name (map removeAnnotations patterns)

387+freshName =

388+ do (Env htc uid) <- State.get

389+ State.put (Env htc (uid + 1))

390+ return ("_p" ++ show uid)