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