on master help sign in
Remove surface syntax for multiway if
2b577feEvan Czaplicki
src/AST/Expression/General.hs+19−21
@@ -49,7 +49,7 @@ data Expr' ann def var typ
49 | Binop var (Expr ann def var typ) (Expr ann def var typ)
49 | Binop var (Expr ann def var typ) (Expr ann def var typ)
50 | Lambda (Pattern.Pattern ann var) (Expr ann def var typ)
50 | Lambda (Pattern.Pattern ann var) (Expr ann def var typ)
51 | App (Expr ann def var typ) (Expr ann def var typ)
51 | App (Expr ann def var typ) (Expr ann def var typ)
52− | MultiIf [(Expr ann def var typ, Expr ann def var typ)] (Expr ann def var typ)
52+ | If [(Expr ann def var typ, Expr ann def var typ)] (Expr ann def var typ)
53 | Let [def] (Expr ann def var typ)
53 | Let [def] (Expr ann def var typ)
54 | Case (Expr ann def var typ) [(Pattern.Pattern ann var, Expr ann def var typ)]
54 | Case (Expr ann def var typ) [(Pattern.Pattern ann var, Expr ann def var typ)]
55 | Data String [Expr ann def var typ]
55 | Data String [Expr ann def var typ]
@@ -161,27 +161,25 @@ instance (P.Pretty def, P.Pretty var, Var.ToString var) => P.Pretty (Expr' ann d
161 func:args =
161 func:args =
162 map (P.pretty dealiaser True) (collectApps expr ++ [arg])
162 map (P.pretty dealiaser True) (collectApps expr ++ [arg])
163
163
164− MultiIf [(condition, thenBranch)] elseBranch ->
164+ If branches finally ->
165− P.parensIf needsParens $ P.sep $
165+ let
166− [ P.text "if" <+> P.pretty dealiaser False condition <+> P.text "then"
166+ prettyFinally =
167− , P.nest 4 (P.pretty dealiaser False thenBranch)
168− , P.text "else"
169− , P.nest 4 (P.pretty dealiaser False elseBranch)
167+ P.nest 4 (P.pretty dealiaser False finally)
170− ]
171
168
172− MultiIf branches finally ->
169+ prettyBranch (condition, thenBranch) (firstLine, rest) =
173− P.parensIf needsParens $
170+ ( P.text "if" <+> P.pretty dealiaser False condition <+> P.text "then"
174− P.text "if" $$ nest 3 (vcat $ map iff branches ++ [final])
171+ ,
175− where
172+ [ P.nest 4 (P.pretty dealiaser False thenBranch)
176− iff (condition, branch) =
173+ , P.text "else" <+> firstLine
177− P.text "|" <+>
174+ ]
178− P.hang
175+ ++ rest
179− (P.pretty dealiaser False condition <+> P.text "->")
176+ )
180− 2
177+ in
181− (P.pretty dealiaser False branch)
178+ P.parensIf needsParens $ P.sep $ uncurry (:) $
182−
179+ foldr
183− final =
180+ prettyBranch
184− P.hang (P.text "| True -> ") 2 (P.pretty dealiaser False finally)
181+ ( P.empty, [prettyFinally] )
182+ branches
185
183
186 Let defs body ->
184 Let defs body ->
187 P.parensIf needsParens $
185 P.parensIf needsParens $
src/Canonicalize.hs+2−2
@@ -416,8 +416,8 @@ expression env (A.A region validExpr) =
416 App func arg ->
416 App func arg ->
417 App <$> go func <*> go arg
417 App <$> go func <*> go arg
418
418
419− MultiIf branches finally ->
419+ If branches finally ->
420− MultiIf
420+ If
421 <$> T.traverse go' branches
421 <$> T.traverse go' branches
422 <*> go finally
422 <*> go finally
423 where
423 where
src/Canonicalize/Sort.hs+2−2
@@ -74,8 +74,8 @@ reorder (A.A ann expression) =
74 App func arg ->
74 App func arg ->
75 App <$> reorder func <*> reorder arg
75 App <$> reorder func <*> reorder arg
76
76
77− MultiIf branches finally ->
77+ If branches finally ->
78− MultiIf
78+ If
79 <$> mapM (\(cond,branch) -> (,) <$> reorder cond <*> reorder branch) branches
79 <$> mapM (\(cond,branch) -> (,) <$> reorder cond <*> reorder branch) branches
80 <*> reorder finally
80 <*> reorder finally
81
81
src/Generate/JavaScript.hs+2−2
@@ -202,7 +202,7 @@ exprToCode tcc annotatedExpr@(A.A _ expr) =
202 Let defs body ->
202 Let defs body ->
203 generateLet tcc defs body
203 generateLet tcc defs body
204
204
205− MultiIf branches finally ->
205+ If branches finally ->
206 generateIf tcc branches finally
206 generateIf tcc branches finally
207
207
208 Case expr branches ->
208 Case expr branches ->
@@ -410,7 +410,7 @@ crushIfsHelp visitedBranches unvisitedBranches finally =
410 case unvisitedBranches of
410 case unvisitedBranches of
411 [] ->
411 [] ->
412 case finally of
412 case finally of
413− A.A _ (MultiIf subBranches subFinally) ->
413+ A.A _ (If subBranches subFinally) ->
414 crushIfsHelp visitedBranches subBranches subFinally
414 crushIfsHelp visitedBranches subBranches subFinally
415
415
416 _ ->
416 _ ->
src/Nitpick/PatternMatches.hs+1−1
@@ -136,7 +136,7 @@ checkExpression tagDict (A.A region expression) =
136 E.App func arg ->
136 E.App func arg ->
137 go2 func arg
137 go2 func arg
138
138
139− E.MultiIf branches finally ->
139+ E.If branches finally ->
140 F.traverse_ (uncurry go2) branches
140 F.traverse_ (uncurry go2) branches
141 <* go finally
141 <* go finally
142
142
src/Optimize/Substitute.hs+2−2
@@ -32,8 +32,8 @@ subst old new expression =
32 App func arg ->
32 App func arg ->
33 App (f func) (f arg)
33 App (f func) (f arg)
34
34
35− MultiIf branches finally ->
35+ If branches finally ->
36− MultiIf (map (f *** f) branches) (f finally)
36+ If (map (f *** f) branches) (f finally)
37
37
38 Let defs body ->
38 Let defs body ->
39 if anyShadow
39 if anyShadow
src/Optimize/TailCalls.hs+2−2
@@ -147,12 +147,12 @@ findTailCalls context annExpr@(A.A _ expression) =
147 Result isTailCall (List.foldl' apply optFunc optArgs)
147 Result isTailCall (List.foldl' apply optFunc optArgs)
148
148
149
149
150− MultiIf branches finally ->
150+ If branches finally ->
151 let
151 let
152 crawlBranch (cond,branch) =
152 crawlBranch (cond,branch) =
153 (,) <$> justConvert cond <*> keepLooking branch
153 (,) <$> justConvert cond <*> keepLooking branch
154 in
154 in
155− MultiIf
155+ If
156 <$> T.traverse crawlBranch branches
156 <$> T.traverse crawlBranch branches
157 <*> keepLooking finally
157 <*> keepLooking finally
158
158
src/Parse/Expression.hs+12−37
@@ -18,8 +18,6 @@ import qualified AST.Literal as L
18import qualified AST.Pattern as P
18import qualified AST.Pattern as P
19import qualified AST.Variable as Var
19import qualified AST.Variable as Var
20import qualified Reporting.Annotation as A
20import qualified Reporting.Annotation as A
21−import qualified Reporting.Crash as Crash
22−import qualified Reporting.Region as R
23
21
24
22
25-------- Basic Terms --------
23-------- Basic Terms --------
@@ -197,8 +195,7 @@ appExpr =
197
195
198expr :: IParser Source.Expr
196expr :: IParser Source.Expr
199expr =
197expr =
200− addLocation (choice [ letExpr, caseExpr ])
198+ addLocation (choice [ letExpr, caseExpr, ifExpr ])
201− <|> ifExpr
202 <|> lambdaExpr
199 <|> lambdaExpr
203 <|> binaryExpr
200 <|> binaryExpr
204 <?> "an expression"
201 <?> "an expression"
@@ -209,45 +206,23 @@ binaryExpr =
209 Binop.binops appExpr lastExpr anyOp
206 Binop.binops appExpr lastExpr anyOp
210 where
207 where
211 lastExpr =
208 lastExpr =
212− addLocation (choice [ letExpr, caseExpr ])
209+ addLocation (choice [ letExpr, caseExpr, ifExpr ])
213− <|> ifExpr
214 <|> lambdaExpr
210 <|> lambdaExpr
215 <?> "an expression"
211 <?> "an expression"
216
212
217
213
218−ifExpr :: IParser Source.Expr
214+ifExpr :: IParser Source.Expr'
219ifExpr =
215ifExpr =
220− do start <- getMyPosition
221− try (reserved "if")
216+ do try (reserved "if")
222 whitespace
217 whitespace
223− makeExpr <- normal <|> multiIf
224− end <- getMyPosition
225− return (makeExpr (R.Region start end))
226− where
227− normal =
228− do condition <- expr
218+ condition <- expr
229− padded (reserved "then")
219+ padded (reserved "then")
230− thenBranch <- expr
220+ thenBranch <- expr
231− whitespace <?> "an 'else' branch"
221+ whitespace <?> "an 'else' branch"
232− reserved "else" <?> "an 'else' branch"
222+ reserved "else" <?> "an 'else' branch"
233− whitespace
223+ whitespace
234− elseBranch <- expr
224+ elseBranch <- expr
235− return $ \region -> A.A region (E.MultiIf [(condition, thenBranch)] elseBranch)
225+ return (E.If [(condition, thenBranch)] elseBranch)
236−
237− multiIf =
238− do branches <- spaceSep1 multiBranch
239− return $ \region -> A.A region (E.MultiIf branches (crash region))
240−
241− crash region =
242− A.A region (E.Crash (Crash.IncompleteMultiIf region))
243−
244− multiBranch =
245− do string "|"
246− whitespace
247− condition <- expr
248− padded rightArrow
249− branch <- expr
250− return (condition, branch)
251
226
252
227
253lambdaExpr :: IParser Source.Expr
228lambdaExpr :: IParser Source.Expr
src/Type/Constrain/Expression.hs+1−1
@@ -98,7 +98,7 @@ constrain env annotatedExpr@(A.A region expression) tipe =
98 in
98 in
99 constrainApp env region f args tipe
99 constrainApp env region f args tipe
100
100
101− E.MultiIf branches finally ->
101+ E.If branches finally ->
102 constrainIf env region branches finally tipe
102 constrainIf env region branches finally tipe
103
103
104 E.Case expr branches ->
104 E.Case expr branches ->
src/Validate.hs+2−2
@@ -213,8 +213,8 @@ expression (A.A ann sourceExpression) =
213 <$> expression funcExpr
213 <$> expression funcExpr
214 <*> expression argExpr
214 <*> expression argExpr
215
215
216− MultiIf branches finally ->
216+ If branches finally ->
217− MultiIf
217+ If
218 <$> T.traverse both branches
218 <$> T.traverse both branches
219 <*> expression finally
219 <*> expression finally
220
220