fc17235 · elk · git.iko.soy

src/AST/Expression/Canonical.hs+13−2

compare with master

unifiedsplit

@@ -24,12 +24,23 @@ type Expr' =

24

25

26data Def

27− = Definition Pattern.CanonicalPattern Expr (Maybe (A.Located Type.Canonical))

27+ = Definition Facts Pattern.CanonicalPattern Expr (Maybe (A.Located Type.Canonical))

28 deriving (Show)

29

30

31+data Facts = Facts

32+ { dependencies :: [Var.TopLevel]

33+ }

34+ deriving (Eq, Ord, Show)

35+

36+

37+dummyFacts :: Facts

38+dummyFacts =

39+ Facts (error "This should be set by Canonicalize.Sort")

40+

41+

31instance P.Pretty Def where

42instance P.Pretty Def where

32− pretty dealiaser _ (Definition pattern expr maybeTipe) =

43+ pretty dealiaser _ (Definition _ pattern expr maybeTipe) =

33 P.vcat [ annotation, definition ]

44 P.vcat [ annotation, definition ]

34 where

45 where

35 definition =

46 definition =

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

@@ -26,10 +26,11 @@ data Def

26

27data Facts = Facts

28 { tailRecursionDetails :: Maybe String

29+ , dependencies :: [Var.TopLevel]

29 }

30 }

30 deriving (Show)

31 deriving (Show)

31

32

33

33dummyFacts :: Facts

34dummyFacts :: Facts

34dummyFacts =

35dummyFacts =

35− Facts Nothing

36+ Facts Nothing []

src/AST/Variable.hs+13−1

@@ -11,12 +11,24 @@ import qualified AST.Module.Name as ModuleName

11import qualified Reporting.PrettyPrint as P

12

13

14−-- VARIABLES

14+-- RAW NAMES

15

16newtype Raw = Raw String

17 deriving (Eq, Ord, Show)

18

19

20+-- TOP LEVEL NAMES

21+

22+data TopLevel = TopLevelVar

23+ { topHome :: ModuleName.Canonical

24+ , topName :: String

25+ }

26+ deriving (Eq, Ord, Show)

27+

28+

29+

30+-- CANONICAL NAMES

31+

20data Home

32data Home

21 = BuiltIn

33 = BuiltIn

22 | Module ModuleName.Canonical

34 | Module ModuleName.Canonical

src/Canonicalize.hs+2−2

@@ -337,7 +337,7 @@ declaration env (A.A ann@(region,_) decl) =

337 case decl of

338 D.Definition (Valid.Definition pat expr typ) ->

339 D.Definition <$> (

340− Canonical.Definition

340+ Canonical.Definition Canonical.dummyFacts

341 <$> pattern env pat

342 <*> expression env expr

343 <*> T.traverse (regionType env) typ

@@ -440,7 +440,7 @@ expression env (A.A region validExpr) =

440 foldr Env.addPattern env $ map (\(Valid.Definition p _ _) -> p) defs

441

442 rename' (Valid.Definition p body mtipe) =

443− Canonical.Definition

443+ Canonical.Definition Canonical.dummyFacts

444 <$> pattern env' p

445 <*> expression env' body

446 <*> T.traverse (regionType env') mtipe

src/Canonicalize/Declaration.hs+10−4

@@ -19,10 +19,12 @@ toExpr moduleName decls =

19

20toDefs :: ModuleName.Canonical -> D.CanonicalDecl -> [Canonical.Def]

21toDefs moduleName (A.A (region,_) decl) =

22+ let

23+ typeVar =

22− let typeVar = Var.fromModule moduleName

24+ Var.fromModule moduleName

23

25

24− loc expr =

26+ loc expr =

25− A.A region expr

27+ A.A region expr

26 in

28 in

27 case decl of

29 case decl of

28 D.Definition def ->

30 D.Definition def ->

@@ -91,4 +93,8 @@ buildFunction body@(A.A ann _) vars =

91

93

92definition :: String -> Canonical.Expr -> R.Region -> T.Canonical -> Canonical.Def

94definition :: String -> Canonical.Expr -> R.Region -> T.Canonical -> Canonical.Def

93definition name expr@(A.A ann _) region tipe =

95definition name expr@(A.A ann _) region tipe =

94− Canonical.Definition (A.A ann (P.Var name)) expr (Just (A.A region tipe))

96+ Canonical.Definition

97+ Canonical.dummyFacts

98+ (A.A ann (P.Var name))

99+ expr

100+ (Just (A.A region tipe))

src/Canonicalize/Sort.hs+4−4

@@ -123,7 +123,7 @@ reorder (A.A ann expression) =

123 let defss = map Graph.flattenSCC sccs

124

125 -- remove let-bound variables from the context

126− forM_ defs $ \(Canonical.Definition pattern _ _) -> do

126+ forM_ defs $ \(Canonical.Definition _ pattern _ _) -> do

127 bound pattern

128 mapM free (ctors pattern)

129

@@ -193,7 +193,7 @@ buildDefGraph defs =

193 zipWith (\n (pdef,deps) -> (pdef,n,deps)) [0..]

194

195 variableToKey :: (Canonical.Def, Int, [String]) -> [(String, Int)]

196− variableToKey (Canonical.Definition pattern _ _, key, _) =

196+ variableToKey (Canonical.Definition _ pattern _ _, key, _) =

197 [ (var, key) | var <- P.boundVarList pattern ]

198

199 variableToKeyMap :: [(Canonical.Def, Int, [String])] -> Map.Map String Int

@@ -212,7 +212,7 @@ buildDefGraph defs =

212reorderAndGetDependencies

213 :: Canonical.Def

214 -> State (Set.Set String) (Canonical.Def, [String])

215−reorderAndGetDependencies (Canonical.Definition pattern expr mType) =

215+reorderAndGetDependencies (Canonical.Definition facts pattern expr mType) =

216 do globalFrees <- get

217 -- work in a fresh environment

218 put Set.empty

@@ -220,4 +220,4 @@ reorderAndGetDependencies (Canonical.Definition pattern expr mType) =

220 localFrees <- get

221 -- merge with global frees

222 modify (Set.union globalFrees)

223− return (Canonical.Definition pattern expr' mType, Set.toList localFrees)

223+ return (Canonical.Definition facts pattern expr' mType, Set.toList localFrees)

src/Docs/Centralize.hs+1−1

@@ -54,7 +54,7 @@ toRawDocs decls =

54addDeclToDocs :: D.CanonicalDecl -> Raw -> Raw

55addDeclToDocs (A.A (region,maybeComment) decl) docs =

56 case decl of

57− D.Definition (Canonical.Definition (A.A subregion (P.Var name)) _ maybeType) ->

57+ D.Definition (Canonical.Definition _ (A.A subregion (P.Var name)) _ maybeType) ->

58 let

59 info =

60 ( maybeComment

src/Nitpick/PatternMatches.hs+1−1

@@ -145,7 +145,7 @@ checkExpression tagDict (A.A region expression) =

145 go body

146 <* F.traverse_ goDef defs

147 where

148− goDef (Canonical.Definition pattern expr _) =

148+ goDef (Canonical.Definition _ pattern expr _) =

149 goPattern [pattern]

150 <* go expr

151

src/Optimize/TailCalls.hs+7−2

@@ -51,7 +51,7 @@ mapSnd func (x, a) =

51-- CONVERT DEFINITIONS

52

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

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

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

55 let

56 (args, body) =

57 Expr.collectLambdas expression

@@ -71,9 +71,14 @@ detectTailRecursion (Can.Definition pattern expression _) =

71

72 lambda x e =

73 A.A () (Lambda x e)

74+

75+ facts =

76+ Opt.Facts

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

78+ (Can.dependencies canonFacts)

74 in

79 in

75 Opt.Definition

80 Opt.Definition

76− (Opt.Facts (if isTailCall then fmap fst context else Nothing))

81+ facts

77 (removeAnnotations pattern)

82 (removeAnnotations pattern)

78 (foldr lambda optExpr (map removeAnnotations args))

83 (foldr lambda optExpr (map removeAnnotations args))

79

84

src/Type/Constrain/Expression.hs+4−4

@@ -451,7 +451,7 @@ collectPairs index items =

451-- EXPAND PATTERNS

452

453expandPattern :: Canonical.Def -> [Canonical.Def]

454−expandPattern def@(Canonical.Definition lpattern expr maybeType) =

454+expandPattern def@(Canonical.Definition facts lpattern expr maybeType) =

455 let (A.A patternRegion pattern) = lpattern

456 in

457 case pattern of

@@ -471,13 +471,13 @@ expandPattern def@(Canonical.Definition lpattern expr maybeType) =

471 localVar name =

472 A.A patternRegion (E.localVar name)

473

474− mainDef = Canonical.Definition (pvar combinedName) expr maybeType

474+ mainDef = Canonical.Definition facts (pvar combinedName) expr maybeType

475

476 toDef name =

477 let extract =

478 E.Case (localVar combinedName) [(lpattern, localVar name)]

479 in

480− Canonical.Definition (pvar name) (A.A patternRegion extract) Nothing

480+ Canonical.Definition facts (pvar name) (A.A patternRegion extract) Nothing

481

482

483-- CONSTRAIN DEFINITIONS

@@ -493,7 +493,7 @@ data Info = Info

493

494

495constrainDef :: Env.Environment -> Info -> Canonical.Def -> IO Info

496−constrainDef env info (Canonical.Definition (A.A patternRegion pattern) expr maybeTipe) =

496+constrainDef env info (Canonical.Definition _ (A.A patternRegion pattern) expr maybeTipe) =

497 let qs = [] -- should come from the def, but I'm not sure what would live there...

498 in

499 case (pattern, maybeTipe) of