fc17235 · elk · git.iko.soy

git.iko.soy/elk

Merge branch 'pr/1038'

commitfc17235d3853a9aa274c4eba599d2c61c275c4af authorEvan Czaplicki <info@elm-lang.org> dateFri 28 Aug 2015, 20:38 (11 years ago) parent7e1de43 c5c4da6

10 files changed+57−22

compare with master

unifiedsplit

src/AST/Expression/Canonical.hs+13−2 src/AST/Expression/Optimized.hs+2−1 src/AST/Variable.hs+13−1 src/Canonicalize.hs+2−2 src/Canonicalize/Declaration.hs+10−4 src/Canonicalize/Sort.hs+4−4 src/Docs/Centralize.hs+1−1 src/Nitpick/PatternMatches.hs+1−1 src/Optimize/TailCalls.hs+7−2 src/Type/Constrain/Expression.hs+4−4

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

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

2424

2525

2626data Def

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

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

2828 deriving (Show)

2929

3030

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+

3142instance P.Pretty Def where

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

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

3344 P.vcat [ annotation, definition ]

3445 where

3546 definition =

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

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

2626

2727data Facts = Facts

2828 { tailRecursionDetails :: Maybe String

29+ , dependencies :: [Var.TopLevel]

2930 }

3031 deriving (Show)

3132

3233

3334dummyFacts :: Facts

3435dummyFacts =

35− Facts Nothing

36+ Facts Nothing []

src/AST/Variable.hs+13−1

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

1111import qualified Reporting.PrettyPrint as P

1212

1313

14−-- VARIABLES

14+-- RAW NAMES

1515

1616newtype Raw = Raw String

1717 deriving (Eq, Ord, Show)

1818

1919

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+

2032data Home

2133 = BuiltIn

2234 | Module ModuleName.Canonical

src/Canonicalize.hs+2−2

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

337337 case decl of

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

339339 D.Definition <$> (

340− Canonical.Definition

340+ Canonical.Definition Canonical.dummyFacts

341341 <$> pattern env pat

342342 <*> expression env expr

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

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

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

441441

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

443− Canonical.Definition

443+ Canonical.Definition Canonical.dummyFacts

444444 <$> pattern env' p

445445 <*> expression env' body

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

src/Canonicalize/Declaration.hs+10−4

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

1919

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

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

22− let typeVar = Var.fromModule moduleName

22+ let

23+ typeVar =

24+ Var.fromModule moduleName

2325

24− loc expr =

25− A.A region expr

26+ loc expr =

27+ A.A region expr

2628 in

2729 case decl of

2830 D.Definition def ->

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

9193

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

9395definition 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) =

123123 let defss = map Graph.flattenSCC sccs

124124

125125 -- remove let-bound variables from the context

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

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

127127 bound pattern

128128 mapM free (ctors pattern)

129129

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

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

194194

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

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

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

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

198198

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

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

212212reorderAndGetDependencies

213213 :: Canonical.Def

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

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

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

216216 do globalFrees <- get

217217 -- work in a fresh environment

218218 put Set.empty

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

220220 localFrees <- get

221221 -- merge with global frees

222222 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 =

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

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

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

5858 let

5959 info =

6060 ( maybeComment

src/Nitpick/PatternMatches.hs+1−1

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

145145 go body

146146 <* F.traverse_ goDef defs

147147 where

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

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

149149 goPattern [pattern]

150150 <* go expr

151151

src/Optimize/TailCalls.hs+7−2

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

5151-- CONVERT DEFINITIONS

5252

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

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

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

5555 let

5656 (args, body) =

5757 Expr.collectLambdas expression

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

7171

7272 lambda x e =

7373 A.A () (Lambda x e)

74+

75+ facts =

76+ Opt.Facts

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

78+ (Can.dependencies canonFacts)

7479 in

7580 Opt.Definition

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

81+ facts

7782 (removeAnnotations pattern)

7883 (foldr lambda optExpr (map removeAnnotations args))

7984

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

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

451451-- EXPAND PATTERNS

452452

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

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

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

455455 let (A.A patternRegion pattern) = lpattern

456456 in

457457 case pattern of

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

471471 localVar name =

472472 A.A patternRegion (E.localVar name)

473473

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

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

475475

476476 toDef name =

477477 let extract =

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

479479 in

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

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

481481

482482

483483-- CONSTRAIN DEFINITIONS

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

493493

494494

495495constrainDef :: 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) =

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

498498 in

499499 case (pattern, maybeTipe) of