137ba16 · elk · git.iko.soy

62expression :: Canonical.Expr -> State Int (Expression ())

63expression (A region expr) =

64 case expr of

65+ Var var ->

65− Var var -> return $ Var.canonical var

66+ return $ Var.canonical var

66

67

68+ Literal lit ->

67− Literal lit -> return $ literal lit

69+ return $ literal lit

68

70

69 Range lo hi ->

71 Range lo hi ->

70− do lo' <- expression lo

72+ do lo' <- expression lo

71− hi' <- expression hi

73+ hi' <- expression hi

72− return $ _List "range" `call` [lo',hi']

74+ return $ _List "range" `call` [lo',hi']

73

75

74 Access e field ->

76 Access e field ->

75− do e' <- expression e

77+ do e' <- expression e

76− return $ DotRef () e' (var (Var.varName field))

78+ return $ DotRef () e' (var (Var.varName field))

77

79

78 Remove e field ->

80 Remove e field ->

79− do e' <- expression e

81+ do e' <- expression e

80− return $ _Utils "remove" `call` [ string (Var.varName field), e' ]

82+ return $ _Utils "remove" `call` [ string (Var.varName field), e' ]

81

83

82 Insert e field value ->

84 Insert e field value ->

83− do value' <- expression value

85+ do value' <- expression value

84− e' <- expression e

86+ e' <- expression e

85− return $ _Utils "insert" `call` [ string (Var.varName field), value', e' ]

87+ return $ _Utils "insert" `call` [ string (Var.varName field), value', e' ]

86

88

87 Modify e fields ->

89 Modify e fields ->

88− do e' <- expression e

90+ do e' <- expression e

89− fields' <-

91+ fields' <-

90 forM fields $ \(field, value) ->

92 forM fields $ \(field, value) ->

91 do value' <- expression value

93 do value' <- expression value

92 return $ ArrayLit () [ string (Var.varName field), value' ]

94 return $ ArrayLit () [ string (Var.varName field), value' ]

93

95

94− return $ _Utils "replace" `call` [ArrayLit () fields', e']

96+ return $ _Utils "replace" `call` [ArrayLit () fields', e']

95

97

96 Record fields ->

98 Record fields ->

97− do fields' <-

99+ do fields' <-

98 forM fields $ \(field, e) ->

100 forM fields $ \(field, e) ->

99 (,) (Var.varName field) <$> expression e

101 (,) (Var.varName field) <$> expression e

100

102

101− let fieldMap =

103+ let fieldMap =

102 List.foldl' combine Map.empty fields'

104 List.foldl' combine Map.empty fields'

103

105

104− return $ ObjectLit () $ (prop "_", hidden fieldMap) : visible fieldMap

106+ return $ ObjectLit () $ (prop "_", hidden fieldMap) : visible fieldMap

105 where

107 where

106 combine record (field, value) =

108 combine record (field, value) =

107 Map.insertWith (++) field [value] record

109 Map.insertWith (++) field [value] record

113 visible fs =

115 visible fs =

114 map (first prop) (Map.toList (Map.map head fs))

116 map (first prop) (Map.toList (Map.map head fs))

115

117

118+ Binop op e1 e2 ->

116− Binop op e1 e2 -> binop region op e1 e2

119+ binop region op e1 e2

117

120

118 Lambda p e@(A ann _) ->

121 Lambda p e@(A ann _) ->

119− do (args, body) <- foldM depattern ([], innerBody) (reverse patterns)

122+ do (args, body) <- foldM depattern ([], innerBody) (reverse patterns)

120− body' <- expression body

123+ body' <- expression body

124+ return $

121− return $ case length args < 2 || length args > 9 of

125+ case length args < 2 || length args > 9 of

122− True -> foldr (==>) body' (map (:[]) args)

126+ True -> foldr (==>) body' (map (:[]) args)

123− False -> ref ("F" ++ show (length args)) <| (args ==> body')

127+ False -> ref ("F" ++ show (length args)) <| (args ==> body')

124 where

128 where

125 depattern (args, body) pattern =

129 depattern (args, body) pattern =

126 case pattern of

130 case pattern of

131+ P.Var x ->

127− P.Var x -> return (args ++ [ Var.varName x ], body)

132+ return (args ++ [ Var.varName x ], body)

133+ _ ->

128− _ -> do arg <- Case.newVar

134+ do arg <- Case.newVar

129 return ( args ++ [arg]

135 return ( args ++ [arg]

130− , A ann (Case (A ann (localVar arg)) [(pattern, body)]))

136+ , A ann (Case (A ann (localVar arg)) [(pattern, body)])

137+ )

131

138

132 (patterns, innerBody) = collect [p] e

139 (patterns, innerBody) = collect [p] e

133

140

137 _ -> (patterns, lexpr)

144 _ -> (patterns, lexpr)

138

145

139 App e1 e2 ->

146 App e1 e2 ->

140− do func' <- expression func

147+ do func' <- expression func

141− args' <- mapM expression args

148+ args' <- mapM expression args

149+ return $

142− return $ case args' of

150+ case args' of

143− [arg] -> func' <| arg

151+ [arg] -> func' <| arg

144− _ | length args' <= 9 -> ref aN `call` (func':args')

152+ _ | length args' <= 9 -> ref aN `call` (func':args')

145− | otherwise -> foldl1 (<|) (func':args')

153+ | otherwise -> foldl1 (<|) (func':args')

146 where

154 where

147 aN = "A" ++ show (length args)

155 aN = "A" ++ show (length args)

148 (func, args) = getArgs e1 [e2]

156 (func, args) = getArgs e1 [e2]

152 _ -> (func, args)

160 _ -> (func, args)

153

161

154 Let defs e ->

162 Let defs e ->

155− do let (defs',e') = flattenLets defs e

163+ do let (defs',e') = flattenLets defs e

156− stmts <- concat <$> mapM definition defs'

164+ stmts <- concat <$> mapM definition defs'

157− exp <- expression e'

165+ exp <- expression e'

158− return $ function [] (stmts ++ [ ret exp ]) `call` []

166+ return $ function [] (stmts ++ [ ret exp ]) `call` []

159

167

160 MultiIf branches ->

168 MultiIf branches ->

161− do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e

169+ do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e

170+ return $

162− return $ case last branches of

171+ case last branches of

163− (A _ (Var (Var.Canonical (Var.Module ["Basics"]) "otherwise")), _) ->

172+ (A _ (Var (Var.Canonical (Var.Module ["Basics"]) "otherwise")), _) ->

164− safeIfs branches'

173+ safeIfs branches'

165− (A _ (Literal (Boolean True)), _) -> safeIfs branches'

174+ (A _ (Literal (Boolean True)), _) -> safeIfs branches'

166− _ -> ifs branches' (throw "badIf" region)

175+ _ -> ifs branches' (throw "badIf" region)

167 where

176 where

168 safeIfs branches = ifs (init branches) (snd (last branches))

177 safeIfs branches = ifs (init branches) (snd (last branches))

169 ifs branches finally = foldr iff finally branches

178 ifs branches finally = foldr iff finally branches

170 iff (if', then') else' = CondExpr () if' then' else'

179 iff (if', then') else' = CondExpr () if' then' else'

171

180

172 Case e cases ->

181 Case e cases ->

173− do (tempVar,initialMatch) <- Case.toMatch cases

182+ do (tempVar,initialMatch) <- Case.toMatch cases

174− (revisedMatch, stmt) <-

183+ (revisedMatch, stmt) <-

175− case e of

184+ case e of

176− A _ (Var (Var.Canonical Var.Local x)) ->

185+ A _ (Var (Var.Canonical Var.Local x)) ->

177− return (Case.matchSubst [(tempVar, Var.varName x)] initialMatch, [])

186+ return (Case.matchSubst [(tempVar, Var.varName x)] initialMatch, [])

178− _ ->

187+ _ ->

179− do e' <- expression e

188+ do e' <- expression e

180− return (initialMatch, [VarDeclStmt () [varDecl tempVar e']])

189+ return (initialMatch, [VarDeclStmt () [varDecl tempVar e']])

181− match' <- match region revisedMatch

190+ match' <- match region revisedMatch

182− return (function [] (stmt ++ match') `call` [])

191+ return (function [] (stmt ++ match') `call` [])

183

192

184 ExplicitList es ->

193 ExplicitList es ->

185− do es' <- mapM expression es

194+ do es' <- mapM expression es

186− return $ _List "fromArray" <| ArrayLit () es'

195+ return $ _List "fromArray" <| ArrayLit () es'

187

196

188 Data name es ->

197 Data name es ->

189− do es' <- mapM expression es

198+ do es' <- mapM expression es

190− return $ ObjectLit () (ctor : fields es')

199+ return $ ObjectLit () (ctor : fields es')

191 where

200 where

192 ctor = (prop "ctor", string name)

201 ctor = (prop "ctor", string name)

193 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]

202 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]

194

203

195 GLShader _uid src _tipe ->

204 GLShader _uid src _tipe ->

196− return $ ObjectLit () [(PropString () "src", literal (Str src))]

205+ return $ ObjectLit () [(PropString () "src", literal (Str src))]

197−

206+

198 PortIn name tipe ->

207 PortIn name tipe ->

199 return $ obj ["_P","portIn"] `call`

208 return $ obj ["_P","portIn"] `call`

200 [ string name, Port.incoming tipe ]

209 [ string name, Port.incoming tipe ]

319 _ -> (defs, lexpr)

328 _ -> (defs, lexpr)

320

329

321

330

322−generate :: CanonicalModule -> String

331+generate :: CanonicalModule -> String

323generate modul =

332generate modul =

324 show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++

333 show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++

325 [ assign ("Elm" : names ++ ["make"]) (function [localRuntime] programStmts) ]

334 [ assign ("Elm" : names ++ ["make"]) (function [localRuntime] programStmts) ]

380

389

381 Var.Union _ (Var.Listing ctors _) ->

390 Var.Union _ (Var.Listing ctors _) ->

382 map Var.varName ctors

391 map Var.varName ctors

383−

392+

384 assign path expr =

393 assign path expr =

385 case path of

394 case path of

386 [x] -> VarDeclStmt () [ varDecl x expr ]

395 [x] -> VarDeclStmt () [ varDecl x expr ]