@@ -62,46 +62,48 @@ literal lit =
6262expression :: Canonical.Expr -> State Int (Expression ())
6363expression (A region expr) =
6464 case expr of
65− Var var -> return $ Var.canonical var
65+ Var var ->
66+ return $ Var.canonical var
6667
67− Literal lit -> return $ literal lit
68+ Literal lit ->
69+ return $ literal lit
6870
6971 Range lo hi ->
70− do lo' <- expression lo
71− hi' <- expression hi
72− return $ _List "range" `call` [lo',hi']
72+ do lo' <- expression lo
73+ hi' <- expression hi
74+ return $ _List "range" `call` [lo',hi']
7375
7476 Access e field ->
75− do e' <- expression e
76− return $ DotRef () e' (var (Var.varName field))
77+ do e' <- expression e
78+ return $ DotRef () e' (var (Var.varName field))
7779
7880 Remove e field ->
79− do e' <- expression e
80− return $ _Utils "remove" `call` [ string (Var.varName field), e' ]
81+ do e' <- expression e
82+ return $ _Utils "remove" `call` [ string (Var.varName field), e' ]
8183
8284 Insert e field value ->
83− do value' <- expression value
84− e' <- expression e
85− return $ _Utils "insert" `call` [ string (Var.varName field), value', e' ]
85+ do value' <- expression value
86+ e' <- expression e
87+ return $ _Utils "insert" `call` [ string (Var.varName field), value', e' ]
8688
8789 Modify e fields ->
88− do e' <- expression e
89− fields' <-
90+ do e' <- expression e
91+ fields' <-
9092 forM fields $ \(field, value) ->
9193 do value' <- expression value
9294 return $ ArrayLit () [ string (Var.varName field), value' ]
9395
94− return $ _Utils "replace" `call` [ArrayLit () fields', e']
96+ return $ _Utils "replace" `call` [ArrayLit () fields', e']
9597
9698 Record fields ->
97− do fields' <-
99+ do fields' <-
98100 forM fields $ \(field, e) ->
99101 (,) (Var.varName field) <$> expression e
100102
101− let fieldMap =
103+ let fieldMap =
102104 List.foldl' combine Map.empty fields'
103105
104− return $ ObjectLit () $ (prop "_", hidden fieldMap) : visible fieldMap
106+ return $ ObjectLit () $ (prop "_", hidden fieldMap) : visible fieldMap
105107 where
106108 combine record (field, value) =
107109 Map.insertWith (++) field [value] record
@@ -113,21 +115,26 @@ expression (A region expr) =
113115 visible fs =
114116 map (first prop) (Map.toList (Map.map head fs))
115117
116− Binop op e1 e2 -> binop region op e1 e2
118+ Binop op e1 e2 ->
119+ binop region op e1 e2
117120
118121 Lambda p e@(A ann _) ->
119− do (args, body) <- foldM depattern ([], innerBody) (reverse patterns)
120− body' <- expression body
121− return $ case length args < 2 || length args > 9 of
122− True -> foldr (==>) body' (map (:[]) args)
123− False -> ref ("F" ++ show (length args)) <| (args ==> body')
122+ do (args, body) <- foldM depattern ([], innerBody) (reverse patterns)
123+ body' <- expression body
124+ return $
125+ case length args < 2 || length args > 9 of
126+ True -> foldr (==>) body' (map (:[]) args)
127+ False -> ref ("F" ++ show (length args)) <| (args ==> body')
124128 where
125129 depattern (args, body) pattern =
126130 case pattern of
127− P.Var x -> return (args ++ [ Var.varName x ], body)
128− _ -> do arg <- Case.newVar
131+ P.Var x ->
132+ return (args ++ [ Var.varName x ], body)
133+ _ ->
134+ do arg <- Case.newVar
129135 return ( args ++ [arg]
130− , A ann (Case (A ann (localVar arg)) [(pattern, body)]))
136+ , A ann (Case (A ann (localVar arg)) [(pattern, body)])
137+ )
131138
132139 (patterns, innerBody) = collect [p] e
133140
@@ -137,12 +144,13 @@ expression (A region expr) =
137144 _ -> (patterns, lexpr)
138145
139146 App e1 e2 ->
140− do func' <- expression func
141− args' <- mapM expression args
142− return $ case args' of
143− [arg] -> func' <| arg
144− _ | length args' <= 9 -> ref aN `call` (func':args')
145− | otherwise -> foldl1 (<|) (func':args')
147+ do func' <- expression func
148+ args' <- mapM expression args
149+ return $
150+ case args' of
151+ [arg] -> func' <| arg
152+ _ | length args' <= 9 -> ref aN `call` (func':args')
153+ | otherwise -> foldl1 (<|) (func':args')
146154 where
147155 aN = "A" ++ show (length args)
148156 (func, args) = getArgs e1 [e2]
@@ -152,49 +160,50 @@ expression (A region expr) =
152160 _ -> (func, args)
153161
154162 Let defs e ->
155− do let (defs',e') = flattenLets defs e
156− stmts <- concat <$> mapM definition defs'
157− exp <- expression e'
158− return $ function [] (stmts ++ [ ret exp ]) `call` []
163+ do let (defs',e') = flattenLets defs e
164+ stmts <- concat <$> mapM definition defs'
165+ exp <- expression e'
166+ return $ function [] (stmts ++ [ ret exp ]) `call` []
159167
160168 MultiIf branches ->
161− do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e
162− return $ case last branches of
163− (A _ (Var (Var.Canonical (Var.Module ["Basics"]) "otherwise")), _) ->
164− safeIfs branches'
165− (A _ (Literal (Boolean True)), _) -> safeIfs branches'
166− _ -> ifs branches' (throw "badIf" region)
169+ do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e
170+ return $
171+ case last branches of
172+ (A _ (Var (Var.Canonical (Var.Module ["Basics"]) "otherwise")), _) ->
173+ safeIfs branches'
174+ (A _ (Literal (Boolean True)), _) -> safeIfs branches'
175+ _ -> ifs branches' (throw "badIf" region)
167176 where
168177 safeIfs branches = ifs (init branches) (snd (last branches))
169178 ifs branches finally = foldr iff finally branches
170179 iff (if', then') else' = CondExpr () if' then' else'
171180
172181 Case e cases ->
173− do (tempVar,initialMatch) <- Case.toMatch cases
174− (revisedMatch, stmt) <-
175− case e of
176− A _ (Var (Var.Canonical Var.Local x)) ->
177− return (Case.matchSubst [(tempVar, Var.varName x)] initialMatch, [])
178− _ ->
179− do e' <- expression e
180− return (initialMatch, [VarDeclStmt () [varDecl tempVar e']])
181− match' <- match region revisedMatch
182− return (function [] (stmt ++ match') `call` [])
182+ do (tempVar,initialMatch) <- Case.toMatch cases
183+ (revisedMatch, stmt) <-
184+ case e of
185+ A _ (Var (Var.Canonical Var.Local x)) ->
186+ return (Case.matchSubst [(tempVar, Var.varName x)] initialMatch, [])
187+ _ ->
188+ do e' <- expression e
189+ return (initialMatch, [VarDeclStmt () [varDecl tempVar e']])
190+ match' <- match region revisedMatch
191+ return (function [] (stmt ++ match') `call` [])
183192
184193 ExplicitList es ->
185− do es' <- mapM expression es
186− return $ _List "fromArray" <| ArrayLit () es'
194+ do es' <- mapM expression es
195+ return $ _List "fromArray" <| ArrayLit () es'
187196
188197 Data name es ->
189− do es' <- mapM expression es
190− return $ ObjectLit () (ctor : fields es')
198+ do es' <- mapM expression es
199+ return $ ObjectLit () (ctor : fields es')
191200 where
192201 ctor = (prop "ctor", string name)
193202 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]
194203
195204 GLShader _uid src _tipe ->
196− return $ ObjectLit () [(PropString () "src", literal (Str src))]
197−
205+ return $ ObjectLit () [(PropString () "src", literal (Str src))]
206+
198207 PortIn name tipe ->
199208 return $ obj ["_P","portIn"] `call`
200209 [ string name, Port.incoming tipe ]
@@ -319,7 +328,7 @@ flattenLets defs lexpr@(A _ expr) =
319328 _ -> (defs, lexpr)
320329
321330
322−generate :: CanonicalModule -> String
331+generate :: CanonicalModule -> String
323332generate modul =
324333 show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++
325334 [ assign ("Elm" : names ++ ["make"]) (function [localRuntime] programStmts) ]
@@ -380,7 +389,7 @@ generate modul =
380389
381390 Var.Union _ (Var.Listing ctors _) ->
382391 map Var.varName ctors
383−
392+
384393 assign path expr =
385394 case path of
386395 [x] -> VarDeclStmt () [ varDecl x expr ]