73317ed · elk · git.iko.soy

compiler/Gen/CompileToJS.hs−4

compare with master

unifiedsplit

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

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

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

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

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

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

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

47 where f '\n' = "\\n"

46 where f '\n' = "\\n"

48 f '\'' = "\\'"

47 f '\'' = "\\'"

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

219 Record fs -> makeRecord fs

218 Record fs -> makeRecord fs

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

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

221

220

222− If eb et ef ->

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

224−

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

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

226

222

227 App e1 e2 -> jsApp e1 e2

223 App e1 e2 -> jsApp e1 e2

compiler/Gen/ExtractNoscript.hs+1−1

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

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

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

44 App e1 e2 -> f e1 ++ f e2

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

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

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

47 Var _ -> []

46 Var _ -> []

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

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

49 Data _ es -> concatMap f es

48 Data _ es -> concatMap f es

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

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

51 _ -> []

52

compiler/Model/Ast.hs+5−7

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

40 | Binop String CExpr CExpr

41 | Lambda String CExpr

42 | App CExpr CExpr

43− | If CExpr CExpr CExpr

44 | MultiIf [(CExpr,CExpr)]

43 | MultiIf [(CExpr,CExpr)]

45 | Let [Def] CExpr

44 | Let [Def] CExpr

46 | Var String

45 | Var String

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

149needsParens e =

147needsParens e =

150 case e of

148 case e of

151 Binop _ _ _ -> True

149 Binop _ _ _ -> True

152− Lambda _ _ -> True

150+ Lambda _ _ -> True

153− App _ _ -> True

151+ App _ _ -> True

154− If _ _ _ -> True

152+ MultiIf _ -> True

155− Let _ _ -> True

153+ Let _ _ -> True

156− Case _ _ -> True

154+ Case _ _ -> True

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

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

158 _ -> False

156 _ -> False

compiler/Parse/Expr.hs+12−9

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

146

147ifExpr :: IParser Expr

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

149+ where

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

150+ normal = do

151+ bool <- expr

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

152+ whitespace ; reserved "then" ; whitespace

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

153+ thenBranch <- expr

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

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

153− If e1 e2 <$> expr

155+ elseBranch <- expr

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

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

157+ multiIf = MultiIf <$> spaceSep1 iff

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

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

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

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

157− (,) b <$> expr

160+ (,) b <$> expr

158

161

159lambdaExpr :: IParser CExpr

162lambdaExpr :: IParser CExpr

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

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

compiler/Transform/Optimize.hs+9−4

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

2

3import Ast

4import Located

5−import Control.Arrow (second)

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

6import Data.Char (isAlpha)

7import Substitute

8

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

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

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

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

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

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

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

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

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

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

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

48 _ -> expr

49

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

50+

51−simp_if a b c = If a b c

51+clipBranches [] = []

52+clipBranches (e:es) =

53+ case e of

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

55+ _ -> e : clipBranches es

56+

52

57

53isValue e =

58isValue e =

54 case e of { IntNum _ -> True

59 case e of { IntNum _ -> True

compiler/Transform/Rename.hs−4

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

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

96 `ap` rnm e2

97

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

99− `ap` rnm e2

100− `ap` rnm e3

101−

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

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

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

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

104 `ap` rnm e

100 `ap` rnm e

compiler/Transform/Substitute.hs−1

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

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

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

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

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

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

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

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

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

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

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

compiler/Types/Constrain.hs−8

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

151 in concat $ cs' : cs : css

152 , head ts)

153

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−

162 Data name es ->

154 Data name es ->

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

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

164

156