b0beee4 · elk · git.iko.soy

git.iko.soy/elk

Added Facts to Canonical.Def

commitb0beee478facaa20d6ac9770102464ad5fe2d9f9 authorJoeyEremondi <joey@eremondi.com> dateFri 28 Aug 2015, 12:40 (11 years ago) parenta9658cc

8 files changed+29−16

compare with master

unifiedsplit

src/AST/Expression/Canonical.hs+12−2 src/Canonicalize.hs+2−2 src/Canonicalize/Declaration.hs+4−1 src/Canonicalize/Sort.hs+4−4 src/Docs/Centralize.hs+1−1 src/Nitpick/PatternMatches.hs+1−1 src/Optimize/TailCalls.hs+1−1 src/Type/Constrain/Expression.hs+4−4

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

@@ -24,12 +24,22 @@ 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 =

32+ Facts

33+ { freeVariables :: [Var.Canonical]

34+ } deriving (Eq, Ord, Show)

35+

36+

37+dummyFacts :: Facts

38+dummyFacts = Facts $ error "This should be set by Canonicalize.Sort"

39+

40+

3141instance P.Pretty Def where

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

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

3343 P.vcat [ annotation, definition ]

3444 where

3545 definition =

src/Canonicalize.hs+2−2

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

328328 case decl of

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

330330 D.Definition <$> (

331− Canonical.Definition

331+ Canonical.Definition Canonical.dummyFacts

332332 <$> pattern env pat

333333 <*> expression env expr

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

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

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

432432

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

434− Canonical.Definition

434+ Canonical.Definition Canonical.dummyFacts

435435 <$> pattern env' p

436436 <*> expression env' body

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

src/Canonicalize/Declaration.hs+4−1

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

9191

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

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

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

94+ let

95+ facts = Canonical.Facts (error "Sort needs to fill in refgraph")

96+ in

97+ Canonical.Definition facts (A.A ann (P.Var name)) expr (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

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

144144 go body

145145 <* F.traverse_ goDef defs

146146 where

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

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

148148 goPattern [pattern]

149149 <* go expr

150150

src/Optimize/TailCalls.hs+1−1

@@ -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 _ pattern expression _) =

5555 let

5656 (args, body) =

5757 Expr.collectLambdas expression

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