73317ed · elk · git.iko.soy

git.iko.soy/elk

Switch to using MultiIf for all if expressions. Simplifies AST.

commit73317ed123a557165ff286157c08a1fadfe4372e authorevancz <info@elm-lang.org> dateThu 13 Jun 2013, 16:01 (13 years ago) parent0758ebf

8 files changed+27−38

compare with master

unifiedsplit

compiler/Gen/CompileToJS.hs−4 compiler/Gen/ExtractNoscript.hs+1−1 compiler/Model/Ast.hs+5−7 compiler/Parse/Expr.hs+12−9 compiler/Transform/Optimize.hs+9−4 compiler/Transform/Rename.hs−4 compiler/Transform/Substitute.hs−1 compiler/Types/Constrain.hs−8

compiler/Gen/CompileToJS.hs−4

@@ -42,7 +42,6 @@ jsList ss = "["++ intercalate "," ss ++"]"

4242jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"

4343assign x e = "\nvar " ++ x ++ " = " ++ e ++ ";"

4444ret e = "\nreturn "++ e ++";"

45−iff a b c = a ++ "?" ++ b ++ ":" ++ c

4645quoted s = "'" ++ concatMap f s ++ "'"

4746 where f '\n' = "\\n"

4847 f '\'' = "\\'"

@@ -219,9 +218,6 @@ instance ToJS Expr where

219218 Record fs -> makeRecord fs

220219 Binop op e1 e2 -> binop op `liftM` toJS' e1 `ap` toJS' e2

221220

222− If eb et ef ->

223− parens `liftM` (iff `liftM` toJS' eb `ap` toJS' et `ap` toJS' ef)

224−

225221 Lambda v e -> liftM (jsFunc v . ret) (toJS' e)

226222

227223 App e1 e2 -> jsApp e1 e2

compiler/Gen/ExtractNoscript.hs+1−1

@@ -42,11 +42,11 @@ instance Extract Expr where

4242 App (L _ _ (Var "italic")) e -> tag "i" e

4343 App (L _ _ (Var "monospace")) e -> tag "code" e

4444 App e1 e2 -> f e1 ++ f e2

45− If eb et ef -> f et ++ f ef

4645 Let defs e -> concatMap extract defs ++ f e

4746 Var _ -> []

4847 Case e cases -> concatMap (f . snd) cases

4948 Data _ es -> concatMap f es

49+ MultiIf es -> concatMap (f . snd) es

5050 Markdown doc -> [ Pan.writeHtmlString Pan.def doc ]

5151 _ -> []

5252

compiler/Model/Ast.hs+5−7

@@ -40,7 +40,6 @@ data Expr = IntNum Int

4040 | Binop String CExpr CExpr

4141 | Lambda String CExpr

4242 | App CExpr CExpr

43− | If CExpr CExpr CExpr

4443 | MultiIf [(CExpr,CExpr)]

4544 | Let [Def] CExpr

4645 | Var String

@@ -118,7 +117,6 @@ instance Show Expr where

118117 Lambda x e -> let (xs,e') = getLambdas (notLocated $ Lambda x e) in

119118 concat [ "\\", intercalate " " xs, " -> ", show e' ]

120119 App e1 e2 -> show' e1 ++ " " ++ show' e2

121− If e1 e2 e3 -> concat [ "if ", show e1, " then ", show e2, " else ", show e3 ]

122120 MultiIf (p:ps) -> concat [ "if | ", iff p, sep (map iff ps) ]

123121 where iff (b,e) = show b ++ " -> " ++ show e

124122 sep = concatMap ("\n | " ++)

@@ -149,10 +147,10 @@ getLambdas e = ([],e)

149147needsParens e =

150148 case e of

151149 Binop _ _ _ -> True

152− Lambda _ _ -> True

153− App _ _ -> True

154− If _ _ _ -> True

155− Let _ _ -> True

156− Case _ _ -> True

150+ Lambda _ _ -> True

151+ App _ _ -> True

152+ MultiIf _ -> True

153+ Let _ _ -> True

154+ Case _ _ -> True

157155 Data name (x:xs) -> name /= "Cons"

158156 _ -> False

compiler/Parse/Expr.hs+12−9

@@ -146,15 +146,18 @@ binaryExpr = binops [] appExpr anyOp

146146

147147ifExpr :: IParser Expr

148148ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

149− where normal = do e1 <- expr ; whitespace

150− reserved "then" ; whitespace ; e2 <- expr

151− whitespace <?> "an 'else' branch"

152− reserved "else" <?> "an 'else' branch" ; whitespace

153− If e1 e2 <$> expr

154− multiIf = (MultiIf <$> spaceSep1 iff)

155− where iff = do string "|" ; whitespace

156− b <- expr ; whitespace ; string "->" ; whitespace

157− (,) b <$> expr

149+ where

150+ normal = do

151+ bool <- expr

152+ whitespace ; reserved "then" ; whitespace

153+ thenBranch <- expr

154+ whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace

155+ elseBranch <- expr

156+ return $ MultiIf [(bool, thenBranch), (notLocated (Var "otherwise"), elseBranch)]

157+ multiIf = MultiIf <$> spaceSep1 iff

158+ where iff = do string "|" ; whitespace

159+ b <- expr ; whitespace ; string "->" ; whitespace

160+ (,) b <$> expr

158161

159162lambdaExpr :: IParser CExpr

160163lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

compiler/Transform/Optimize.hs+9−4

@@ -2,7 +2,7 @@ module Optimize (optimize) where

33import Ast

44import Located

5−import Control.Arrow (second)

5+import Control.Arrow (second, (***))

66import Data.Char (isAlpha)

77import Substitute

@@ -41,14 +41,19 @@ instance Simplify Expr where

4141 where ce1'@(L _ _ e1') = f e1

4242 ce2'@(L _ _ e2') = f e2

4343 App e1 e2 -> App (f e1) (f e2)

44− If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)

4544 Let defs e -> Let (map simp defs) (f e)

4645 Data name es -> Data name (map f es)

46+ MultiIf es -> MultiIf . clipBranches $ map (f *** f) es

4747 Case e cases -> Case (f e) (map (second f) cases)

4848 _ -> expr

4949

50−simp_if (L _ _ (Boolean b)) (L _ _ e2) (L _ _ e3) = if b then e2 else e3

51−simp_if a b c = If a b c

50+

51+clipBranches [] = []

52+clipBranches (e:es) =

53+ case e of

54+ (L _ _ (Boolean True), _) -> [e]

55+ _ -> e : clipBranches es

56+

5257

5358isValue e =

5459 case e of { IntNum _ -> True

compiler/Transform/Rename.hs−4

@@ -95,10 +95,6 @@ instance Rename Expr where

9595 App e1 e2 -> App `liftM` rnm e1

9696 `ap` rnm e2

9797

98− If e1 e2 e3 -> If `liftM` rnm e1

99− `ap` rnm e2

100− `ap` rnm e3

101−

10298 MultiIf ps -> MultiIf `liftM` mapM grnm ps

10399 where grnm (b,e) = (,) `liftM` rnm b

104100 `ap` rnm e

compiler/Transform/Substitute.hs−1

@@ -17,7 +17,6 @@ subst old new expr =

1717 Binop op e1 e2 -> Binop op (f e1) (f e2)

1818 Lambda x e -> if x == old then expr else Lambda x (f e)

1919 App e1 e2 -> App (f e1) (f e2)

20− If e1 e2 e3 -> If (f e1) (f e2) (f e3)

2120 MultiIf ps -> MultiIf (map (f *** f) ps)

2221 Let defs e -> Let (map substDef defs) (f e)

2322 where substDef (FnDef name vs e) = FnDef name vs (f e)

compiler/Types/Constrain.hs−8

@@ -151,14 +151,6 @@ gen (L _ span expr) =

151151 in concat $ cs' : cs : css

152152 , head ts)

153153

154− If e1 e2 e3 ->

155− do (a1,c1,t1) <- gen e1

156− (a2,c2,t2) <- gen e2

157− (a3,c3,t3) <- gen e3

158− return ( unionsA [a1,a2,a3]

159− , c1 ++ c2 ++ c3 ++ [ loc e1 span (t1 :=: bool), loc' (t2 :=: t3) ]

160− , t2 )

161−

162154 Data name es ->

163155 gen $ foldl' (\f x -> epos f x $ App f x) (loc' $ Var name) es

164156