e5369f5 · elk · git.iko.soy

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

compare with master

unifiedsplit

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

67 = In String (Type.Port tipe)

68 | Out String expr (Type.Port tipe)

69 | Task String expr (Type.Port tipe)

70− deriving (Show)

70+ deriving (Eq, Show)

71

72

73portName :: PortImpl expr tipe -> String

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

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

19data Def

20 = Def Facts String Expr

21 | TailDef Facts String [String] Expr

22+ deriving (Eq)

22

23

24

24data Facts = Facts

25data Facts = Facts

25 { home :: Maybe ModuleName.Canonical

26 { home :: Maybe ModuleName.Canonical

26 , dependencies :: [Var.TopLevel]

27 , dependencies :: [Var.TopLevel]

27 }

28 }

29+ deriving (Eq)

28

30

29

31

30dummyFacts :: Facts

32dummyFacts :: Facts

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

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

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

55 | GLShader String String Literal.GLShaderTipe

57 | GLShader String String Literal.GLShaderTipe

56 | Crash R.Region (Maybe String)

58 | Crash R.Region (Maybe String)

59+ deriving (Eq)

57

60

58

61

59data Jump

62data Jump

60 = Inline Branch

63 = Inline Branch

61 | Jump Int

64 | Jump Int

65+ deriving (Eq)

62

66

63

67

64data Branch = Branch

68data Branch = Branch

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

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

66 , _branch :: Expr

70 , _branch :: Expr

67− }

71+ }

72+ deriving (Eq)

src/AST/Literal.hs+2−2

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

39 | V4

40 | M4

41 | Texture

42− deriving (Show)

42+ deriving (Eq, Show)

43

44

45glTipeName :: GLTipe -> String

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

59 , uniform :: Map.Map String GLTipe

60 , varying :: Map.Map String GLTipe

61 }

62− deriving (Show)

62+ deriving (Eq, Show)

src/AST/Type.hs+1−1

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

56data Port t

57 = Normal t

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

59− deriving (Show)

59+ deriving (Eq, Show)

60

61

62getPortType :: Port tipe -> tipe

src/Generate/JavaScript.hs+42−11

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

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

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

373

374− DT.Decision testPath edges fallback ->

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

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

375+ let

376−

376+ (tests, deepestSubTree) =

377− let testExpr =

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

378− case fst (head edges) of

378+

379− DT.Constructor _ ->

379+ makeTest (path, test) =

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

380+ do testExpr <- pathToTestableExpr root path test

381−

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

382− DT.Literal _ ->

382+ in

383− accessExpr

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) ]

384

388

389+ DT.Decision testPath edges fallback ->

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

385 caseClauses <- mapM (edgeToCaseClause root) edges

391 caseClauses <- mapM (edgeToCaseClause root) edges

386 caseDefault <- fallbackToDefault root fallback

392 caseDefault <- fallbackToDefault root fallback

387−

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

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

389

394

390

395

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+

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

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

392edgeToCaseClause root (test, subTree) =

412edgeToCaseClause root (test, subTree) =

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

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

394

414

395

415

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+

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

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

397testToExpr test =

428testToExpr test =

398 case test of

429 case test of

src/Optimize/Patterns/DecisionTree.hs+1

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

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

74 , _default :: Maybe (DecisionTree a)

75 }

76+ deriving (Eq)

76

77

78

78data Jump = Jump

79data Jump = Jump

src/Reporting/Region.hs+2−2

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

10 { start :: Position

11 , end :: Position

12 }

13− deriving (Show)

13+ deriving (Eq, Show)

14

15

16data Position = Position

17 { line :: Int

18 , column :: Int

19 }

20− deriving (Show)

20+ deriving (Eq, Show)

21

22

23fromSourcePos :: Parsec.SourcePos -> Position