b0beee4 · elk · git.iko.soy

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

compare with master

unifiedsplit

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

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+

31instance P.Pretty Def where

41instance P.Pretty Def where

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

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

33 P.vcat [ annotation, definition ]

43 P.vcat [ annotation, definition ]

34 where

44 where

35 definition =

45 definition =

src/Canonicalize.hs+2−2

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

328 case decl of

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

330 D.Definition <$> (

331− Canonical.Definition

331+ Canonical.Definition Canonical.dummyFacts

332 <$> pattern env pat

333 <*> expression env expr

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

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

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

432

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

434− Canonical.Definition

434+ Canonical.Definition Canonical.dummyFacts

435 <$> pattern env' p

436 <*> expression env' body

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

src/Canonicalize/Declaration.hs+4−1

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

91

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

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

94+ let

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

96+ in

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

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

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

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

144 go body

145 <* F.traverse_ goDef defs

146 where

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

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

148 goPattern [pattern]

149 <* go expr

150

src/Optimize/TailCalls.hs+1−1

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

55 let

56 (args, body) =

57 Expr.collectLambdas expression

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