git.iko.soy/elk
on f2b3ed7 help sign in
elk/compiler/SourceSyntax/Expression.hs
124 lines 4.6 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2module SourceSyntax.Expression where
4import Data.Data
5import Data.List (intercalate)
6import qualified Text.Pandoc as Pandoc
7import SourceSyntax.PrettyPrint
8import Text.PrettyPrint as PP
9import qualified SourceSyntax.Helpers as Help
10import qualified SourceSyntax.Location as Location
11import qualified SourceSyntax.Pattern as Pattern
12import qualified SourceSyntax.Literal as Literal
13import Types.Types
15type LExpr tipe var = Location.Located (Expr tipe var)
16data Expr t v
17 = Literal Literal.Literal
18 | Var String
19 | Range (LExpr t v) (LExpr t v)
20 | ExplicitList [LExpr t v]
21 | Binop String (LExpr t v) (LExpr t v)
22 | Lambda Pattern.Pattern (LExpr t v)
23 | App (LExpr t v) (LExpr t v)
24 | MultiIf [(LExpr t v,LExpr t v)]
25 | Let [Def t v] (LExpr t v)
26 | Case (LExpr t v) [(Pattern.Pattern, LExpr t v)]
27 | Data String [LExpr t v]
28 | Access (LExpr t v) String
29 | Remove (LExpr t v) String
30 | Insert (LExpr t v) String (LExpr t v)
31 | Modify (LExpr t v) [(String, LExpr t v)]
32 | Record [(String, LExpr t v)]
33 | Markdown Pandoc.Pandoc
34 deriving (Eq, Data, Typeable, Show)
36data Def tipe var
37 = Def Pattern.Pattern (LExpr tipe var)
38 | TypeAnnotation String Type
39 deriving (Eq, Data, Typeable, Show)
41tuple es = Data ("Tuple" ++ show (length es)) es
43delist (Location.L _ _ (Data "::" [h,t])) = h : delist t
44delist _ = []
46instance Pretty (Expr t v) where
47 pretty expr =
48 case expr of
49 Literal lit -> pretty lit
50 Var x@(c:_) -> parensIf (Help.isOp c) (PP.text x)
51 Range e1 e2 -> PP.brackets (pretty e1 <> PP.text ".." <> pretty e2)
52 ExplicitList es -> PP.brackets (commaCat (map pretty es))
53 Binop op e1 e2 -> PP.sep [ prettyParens e1 <+> PP.text op, prettyParens e2 ]
54 Lambda p e -> let (ps,body) = collectLambdas (Location.none $ Lambda p e)
55 in PP.text "\\" <> PP.sep ps <+> PP.text "->" <+> pretty body
56 App _ _ -> PP.hang func 2 (PP.sep args)
57 where func:args = map prettyParens (collectApps (Location.none expr))
58 MultiIf branches -> PP.text "if" $$ nest 3 (vcat $ map iff branches)
59 where
60 iff (b,e) = PP.text "|" <+> PP.hang (pretty b <+> PP.text "->") 2 (pretty e)
61 Let defs e ->
62 PP.sep [ PP.hang (PP.text "let") 4 (PP.vcat (map pretty defs))
63 , PP.text "in" <+> pretty e ]
64 Case e pats ->
65 PP.hang pexpr 2 (PP.vcat (map pretty' pats))
66 where
67 pexpr = PP.sep [ PP.text "case" <+> pretty e, PP.text "of" ]
68 pretty' (p,e) = pretty p <+> PP.text "->" <+> pretty e
69 Data "::" [hd,tl] -> pretty hd <+> PP.text "::" <+> pretty tl
70 Data "[]" [] -> PP.text "[]"
71 Data name es -> PP.hang (PP.text name) 2 (PP.sep (map prettyParens es))
72 Access e x -> prettyParens e <> PP.text "." <> PP.text x
73 Remove e x -> PP.braces (pretty e <+> PP.text "-" <+> PP.text x)
74 Insert (Location.L _ _ (Remove e y)) x v ->
75 PP.braces (pretty e <+> PP.text "-" <+> PP.text y <+> PP.text "|" <+> PP.text x <+> PP.text "=" <+> pretty v)
76 Insert e x v ->
77 PP.braces (pretty e <+> PP.text "|" <+> PP.text x <+> PP.text "=" <+> pretty v)
79 Modify e fs ->
80 PP.braces $ PP.hang (pretty e <+> PP.text "|")
81 4
82 (PP.sep . PP.punctuate PP.comma $ map field fs)
83 where
84 field (x,e) = PP.text x <+> PP.text "<-" <+> pretty e
86 Record fs ->
87 PP.braces $ PP.nest 2 (PP.sep . PP.punctuate PP.comma $ map field fs)
88 where
89 field (x,e) = PP.text x <+> PP.text "=" <+> pretty e
91 Markdown _ -> PP.text "[markdown| ... |]"
93instance Pretty (Def t v) where
94 pretty def =
95 case def of
96 TypeAnnotation name tipe ->
97 PP.text name <+> PP.text ":" <+> PP.text (show tipe)
98 Def pattern expr ->
99 pretty pattern <+> PP.text "=" <+> pretty expr
101collectApps lexpr@(Location.L _ _ expr) =
102 case expr of
103 App a b -> collectApps a ++ [b]
104 _ -> [lexpr]
106collectLambdas lexpr@(Location.L _ _ expr) =
107 case expr of
108 Lambda pattern body ->
109 let (ps, body') = collectLambdas body
110 in (pretty pattern : ps, body')
111 _ -> ([], lexpr)
113prettyParens (Location.L _ _ expr) = parensIf needed (pretty expr)
114 where
115 needed =
116 case expr of
117 Binop _ _ _ -> True
118 Lambda _ _ -> True
119 App _ _ -> True
120 MultiIf _ -> True
121 Let _ _ -> True
122 Case _ _ -> True
123 Data name (x:xs) -> name /= "::"
124 _ -> False