@@ -25,10 +25,12 @@ import AST.Literal
2525import qualified AST.Pattern as P
2626import qualified AST.Variable as Var
2727
28+
2829varDecl :: String -> Expression () -> VarDecl ()
2930varDecl x expr =
3031 VarDecl () (var x) (Just expr)
3132
33+
3234internalImports :: Module.Name -> [VarDecl ()]
3335internalImports name =
3436 [ varDecl "_N" (obj ["Elm","Native"])
@@ -42,11 +44,16 @@ internalImports name =
4244 include alias modul =
4345 varDecl alias (obj ["_N", modul, "make"] <| ref "_elm")
4446
47+
4548_Utils :: String -> Expression ()
46−_Utils x = obj ["_U", x]
49+_Utils x =
50+ obj ["_U", x]
51+
4752
4853_List :: String -> Expression ()
49−_List x = obj ["_L", x]
54+_List x =
55+ obj ["_L", x]
56+
5057
5158literal :: Literal -> Expression ()
5259literal lit =
@@ -57,6 +64,7 @@ literal lit =
5764 FloatNum n -> NumLit () n
5865 Boolean b -> BoolLit () b
5966
67+
6068expression :: Canonical.Expr -> State Int (Expression ())
6169expression (A region expr) =
6270 case expr of
@@ -197,6 +205,7 @@ expression (A region expr) =
197205 return $ obj ["_P","portOut"] `call`
198206 [ string name, Port.outgoing tipe, value' ]
199207
208+
200209definition :: Canonical.Def -> State Int [Statement ()]
201210definition (Canonical.Definition pattern expr@(A region _) _) = do
202211 expr' <- expression expr
@@ -238,8 +247,11 @@ definition (Canonical.Definition pattern expr@(A region _) _) = do
238247 where
239248 vars = P.boundVarList pattern
240249 mkVar = A region . localVar
241− toDef y = let expr = A region $ Case (mkVar "_") [(pattern, mkVar y)]
242− in definition $ Canonical.Definition (P.Var y) expr Nothing
250+ toDef y =
251+ let expr = A region $ Case (mkVar "_") [(pattern, mkVar y)]
252+ in
253+ definition $ Canonical.Definition (P.Var y) expr Nothing
254+
243255
244256match :: Region -> Case.Match -> State Int [Statement ()]
245257match region mtch =
@@ -278,6 +290,7 @@ match region mtch =
278290 Case.Other _ -> acc ++ [m]
279291 _ -> dropEnd (acc ++ [m]) ms
280292
293+
281294clause :: Region -> String -> Case.Clause -> State Int (Bool, CaseClause ())
282295clause region variable (Case.Clause value vars mtch) =
283296 (,) isChar . CaseClause () pattern <$> match region (Case.matchSubst (zip vars vars') mtch)
@@ -286,11 +299,14 @@ clause region variable (Case.Clause value vars mtch) =
286299 (isChar, pattern) =
287300 case value of
288301 Right (Chr c) -> (True, string [c])
289− _ -> (,) False $ case value of
290− Right (Boolean b) -> BoolLit () b
291− Right lit -> literal lit
292− Left (Var.Canonical _ name) ->
293− string name
302+ _ ->
303+ (,) False $
304+ case value of
305+ Right (Boolean b) -> BoolLit () b
306+ Right lit -> literal lit
307+ Left (Var.Canonical _ name) ->
308+ string name
309+
294310
295311flattenLets :: [Canonical.Def] -> Canonical.Expr -> ([Canonical.Def], Canonical.Expr)
296312flattenLets defs lexpr@(A _ expr) =
@@ -298,6 +314,7 @@ flattenLets defs lexpr@(A _ expr) =
298314 Let ds body -> flattenLets (defs ++ ds) body
299315 _ -> (defs, lexpr)
300316
317+
301318generate :: CanonicalModule -> String
302319generate modul =
303320 show . prettyPrint $ setup "Elm" (names ++ ["make"]) ++
@@ -361,42 +378,51 @@ generate modul =
361378 map Var.varName ctors
362379
363380 assign path expr =
364− case path of
365− [x] -> VarDeclStmt () [ varDecl x expr ]
366− _ -> ExprStmt () $
367− AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr
368−
369−binop :: Region -> Var.Canonical -> Canonical.Expr -> Canonical.Expr
370− -> State Int (Expression ())
381+ case path of
382+ [x] -> VarDeclStmt () [ varDecl x expr ]
383+ _ ->
384+ ExprStmt () $
385+ AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr
386+
387+
388+binop
389+ :: Region
390+ -> Var.Canonical
391+ -> Canonical.Expr
392+ -> Canonical.Expr
393+ -> State Int (Expression ())
371394binop region func@(Var.Canonical home op) e1 e2 =
372395 case (home, op) of
373396 (Var.Module ["Basics"], ">>") ->
374− do es <- mapM expression (collectLeftAssoc [e2] e1)
375− return $ ["$"] ==> List.foldl' (\e f -> f <| e) (ref "$") es
397+ do es <- mapM expression (collectLeftAssoc [e2] e1)
398+ return $ ["$"] ==> List.foldl' (\e f -> f <| e) (ref "$") es
376399
377400 (Var.Module ["Basics"], "<<") ->
378− do es <- mapM expression (e1 : collectRightAssoc [] e2)
379− return $ ["$"] ==> foldr (<|) (ref "$") es
401+ do es <- mapM expression (e1 : collectRightAssoc [] e2)
402+ return $ ["$"] ==> foldr (<|) (ref "$") es
380403
381404 (Var.Module ["Basics"], "<|") ->
382− do e2' <- expression e2
383− es <- mapM expression (collectRightAssoc [] e1)
384− return $ foldr (<|) e2' es
405+ do e2' <- expression e2
406+ es <- mapM expression (collectRightAssoc [] e1)
407+ return $ foldr (<|) e2' es
385408
386409 (Var.BuiltIn, "::") ->
387− expression (A region (Data "::" [e1,e2]))
410+ expression (A region (Data "::" [e1,e2]))
388411
389412 (Var.Module ["Basics"], _) ->
390− do e1' <- expression e1
391− e2' <- expression e2
392− return $ case Map.lookup op basicOps of
393− Just f -> f e1' e2'
394− Nothing -> ref "A2" `call` [ Var.canonical func, e1', e2' ]
413+ do e1' <- expression e1
414+ e2' <- expression e2
415+ case Map.lookup op basicOps of
416+ Just f ->
417+ return (f e1' e2')
418+
419+ Nothing ->
420+ return (ref "A2" `call` [ Var.canonical func, e1', e2' ])
395421
396422 _ ->
397− do e1' <- expression e1
398− e2' <- expression e2
399− return (ref "A2" `call` [ Var.canonical func, e1', e2' ])
423+ do e1' <- expression e1
424+ e2' <- expression e2
425+ return (ref "A2" `call` [ Var.canonical func, e1', e2' ])
400426
401427 where
402428 collectRightAssoc es e =
@@ -411,7 +437,8 @@ binop region func@(Var.Canonical home op) e1 e2 =
411437 collectLeftAssoc (e2 : es) e1
412438 _ -> e : es
413439
414− basicOps = Map.fromList (infixOps ++ specialOps)
440+ basicOps =
441+ Map.fromList (infixOps ++ specialOps)
415442
416443 infixOps =
417444 let infixOp str op = (str, InfixExpr () op) in
@@ -435,4 +462,5 @@ binop region func@(Var.Canonical home op) e1 e2 =
435462 , (,) "//" $ \a b -> InfixExpr () OpBOr (InfixExpr () OpDiv a b) (IntLit () 0)
436463 ]
437464
438− cmp op n a b = InfixExpr () op (_Utils "cmp" `call` [a,b]) (IntLit () n)
465+ cmp op n a b =
466+ InfixExpr () op (_Utils "cmp" `call` [a,b]) (IntLit () n)