e5369f5 · elk · git.iko.soy

git.iko.soy/elk

Crush down code generated by decision trees

commite5369f5d955ebb4610ae2ec991660a260651c165 authorEvan Czaplicki <info@elm-lang.org> dateSun 13 Sep 2015, 12:56 (11 years ago) parentd3c72d1

7 files changed+55−18

compare with master

unifiedsplit

src/AST/Expression/General.hs+1−1 src/AST/Expression/Optimized.hs+6−1 src/AST/Literal.hs+2−2 src/AST/Type.hs+1−1 src/Generate/JavaScript.hs+42−11 src/Optimize/Patterns/DecisionTree.hs+1 src/Reporting/Region.hs+2−2

src/AST/Expression/General.hs+1−1

@@ -67,7 +67,7 @@ data PortImpl expr tipe

6767 = In String (Type.Port tipe)

6868 | Out String expr (Type.Port tipe)

6969 | Task String expr (Type.Port tipe)

70− deriving (Show)

70+ deriving (Eq, Show)

7171

7272

7373portName :: PortImpl expr tipe -> String

src/AST/Expression/Optimized.hs+6−1

@@ -19,12 +19,14 @@ import qualified Reporting.Region as R

1919data Def

2020 = Def Facts String Expr

2121 | TailDef Facts String [String] Expr

22+ deriving (Eq)

2223

2324

2425data Facts = Facts

2526 { home :: Maybe ModuleName.Canonical

2627 , dependencies :: [Var.TopLevel]

2728 }

29+ deriving (Eq)

2830

2931

3032dummyFacts :: Facts

@@ -54,14 +56,17 @@ data Expr

5456 | Port (General.PortImpl Expr Type.Canonical)

5557 | GLShader String String Literal.GLShaderTipe

5658 | Crash R.Region (Maybe String)

59+ deriving (Eq)

5760

5861

5962data Jump

6063 = Inline Branch

6164 | Jump Int

65+ deriving (Eq)

6266

6367

6468data Branch = Branch

6569 { _substitutions :: [(String, DT.Path)]

6670 , _branch :: Expr

67− }

71+ }

72+ deriving (Eq)

src/AST/Literal.hs+2−2

@@ -39,7 +39,7 @@ data GLTipe

3939 | V4

4040 | M4

4141 | Texture

42− deriving (Show)

42+ deriving (Eq, Show)

4343

4444

4545glTipeName :: GLTipe -> String

@@ -59,4 +59,4 @@ data GLShaderTipe = GLShaderTipe

5959 , uniform :: Map.Map String GLTipe

6060 , varying :: Map.Map String GLTipe

6161 }

62− deriving (Show)

62+ deriving (Eq, Show)

src/AST/Type.hs+1−1

@@ -56,7 +56,7 @@ data Aliased t

5656data Port t

5757 = Normal t

5858 | Signal { root :: t, arg :: t }

59− deriving (Show)

59+ deriving (Eq, Show)

6060

6161

6262getPortType :: Port tipe -> tipe

src/Generate/JavaScript.hs+42−11

@@ -371,28 +371,59 @@ generateDecisionTree root decisionTree =

371371 DT.Match (Opt.Jump target) ->

372372 return [ BreakStmt () (Just (targetLabel root target)) ]

373373

374− DT.Decision testPath edges fallback ->

375− do accessExpr <- generateJsExpr (pathToExpr root testPath)

376−

377− let testExpr =

378− case fst (head edges) of

379− DT.Constructor _ ->

380− DotRef () accessExpr (Id () "ctor")

381−

382− DT.Literal _ ->

383− accessExpr

374+ DT.Decision testPath [(test, subTree)] (Just fallback) ->

375+ let

376+ (tests, deepestSubTree) =

377+ collapseTests [(testPath, test)] fallback subTree

378+

379+ makeTest (path, test) =

380+ do testExpr <- pathToTestableExpr root path test

381+ return (InfixExpr () OpStrictEq testExpr (testToExpr test))

382+ in

383+ do testExprs <- mapM makeTest tests

384+ let cond = List.foldl1' (InfixExpr () OpLAnd) testExprs

385+ thenBranch <- generateDecisionTree root deepestSubTree

386+ elseBranch <- generateDecisionTree root fallback

387+ return [ IfStmt () cond (BlockStmt () thenBranch) (BlockStmt () elseBranch) ]

384388

389+ DT.Decision testPath edges fallback ->

390+ do testExpr <- pathToTestableExpr root testPath (fst (head edges))

385391 caseClauses <- mapM (edgeToCaseClause root) edges

386392 caseDefault <- fallbackToDefault root fallback

387−

388393 return [ SwitchStmt () testExpr (caseClauses ++ caseDefault) ]

389394

390395

396+collapseTests

397+ :: [(DT.Path, DT.Test)]

398+ -> DT.DecisionTree Opt.Jump

399+ -> DT.DecisionTree Opt.Jump

400+ -> ([(DT.Path, DT.Test)], DT.DecisionTree Opt.Jump)

401+collapseTests tests outerFallback decisionTree =

402+ case decisionTree of

403+ DT.Decision testPath [(test, subTree)] (Just fallback)

404+ | fallback == outerFallback ->

405+ collapseTests ((testPath, test) : tests) outerFallback subTree

406+

407+ _ ->

408+ (tests, decisionTree)

409+

410+

391411edgeToCaseClause :: String -> (DT.Test, DT.DecisionTree Opt.Jump) -> State Int (CaseClause ())

392412edgeToCaseClause root (test, subTree) =

393413 CaseClause () (testToExpr test) <$> generateDecisionTree root subTree

394414

395415

416+pathToTestableExpr :: String -> DT.Path -> DT.Test -> State Int (Expression ())

417+pathToTestableExpr root path exampleTest =

418+ do accessExpr <- generateJsExpr (pathToExpr root path)

419+ case exampleTest of

420+ DT.Constructor _ ->

421+ return (DotRef () accessExpr (Id () "ctor"))

422+

423+ DT.Literal _ ->

424+ return accessExpr

425+

426+

396427testToExpr :: DT.Test -> Expression ()

397428testToExpr test =

398429 case test of

src/Optimize/Patterns/DecisionTree.hs+1

@@ -73,6 +73,7 @@ data DecisionTree a

7373 , _edges :: [(Test, DecisionTree a)]

7474 , _default :: Maybe (DecisionTree a)

7575 }

76+ deriving (Eq)

7677

7778

7879data Jump = Jump

src/Reporting/Region.hs+2−2

@@ -10,14 +10,14 @@ data Region = Region

1010 { start :: Position

1111 , end :: Position

1212 }

13− deriving (Show)

13+ deriving (Eq, Show)

1414

1515

1616data Position = Position

1717 { line :: Int

1818 , column :: Int

1919 }

20− deriving (Show)

20+ deriving (Eq, Show)

2121

2222

2323fromSourcePos :: Parsec.SourcePos -> Position