git.iko.soy/elk
on 22f7f8a help sign in
elk/compiler/SourceSyntax/Expression.hs
129 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 P
9import qualified SourceSyntax.Helpers as Help
10import qualified SourceSyntax.Location as Location
11import qualified SourceSyntax.Pattern as Pattern
12import qualified SourceSyntax.Type as Type
13import qualified SourceSyntax.Literal as Literal
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, Show, Data, Typeable)
36data Def tipe var
37 = Def Pattern.Pattern (LExpr tipe var)
38 | TypeAnnotation String Type.Type
39 deriving (Eq, Show, Data, Typeable)
41tuple es = Data ("_Tuple" ++ show (length es)) es
43delist (Location.L _ _ (Data "::" [h,t])) = h : delist t
44delist _ = []
46saveEnvName = "_save_the_environment!!!"
48dummyLet defs =
49 Location.none $ Let defs (Location.none $ Var saveEnvName)
51instance Pretty (Expr t v) where
52 pretty expr =
53 case expr of
54 Literal lit -> pretty lit
55 Var x -> parensIf (Help.isOp x) (P.text x)
56 Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)
57 ExplicitList es -> P.brackets (commaCat (map pretty es))
58 Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op, prettyParens e2 ]
59 Lambda p e -> let (ps,body) = collectLambdas (Location.none $ Lambda p e)
60 in P.text "\\" <> P.sep ps <+> P.text "->" <+> pretty body
61 App _ _ -> P.hang func 2 (P.sep args)
62 where func:args = map prettyParens (collectApps (Location.none expr))
63 MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
64 where
65 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
66 Let defs e ->
67 P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
68 , P.text "in" <+> pretty e ]
69 Case e pats ->
70 P.hang pexpr 2 (P.vcat (map pretty' pats))
71 where
72 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
73 pretty' (p,e) = pretty p <+> P.text "->" <+> pretty e
74 Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
75 Data "[]" [] -> P.text "[]"
76 Data name es -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
77 Access e x -> prettyParens e <> P.text "." <> P.text x
78 Remove e x -> P.braces (pretty e <+> P.text "-" <+> P.text x)
79 Insert (Location.L _ _ (Remove e y)) x v ->
80 P.braces (pretty e <+> P.text "-" <+> P.text y <+> P.text "|" <+> P.text x <+> P.text "=" <+> pretty v)
81 Insert e x v ->
82 P.braces (pretty e <+> P.text "|" <+> P.text x <+> P.text "=" <+> pretty v)
84 Modify e fs ->
85 P.braces $ P.hang (pretty e <+> P.text "|")
86 4
87 (commaSep $ map field fs)
88 where
89 field (x,e) = P.text x <+> P.text "<-" <+> pretty e
91 Record fs ->
92 P.braces $ P.nest 2 (commaSep $ map field fs)
93 where
94 field (x,e) = P.text x <+> P.text "=" <+> pretty e
96 Markdown _ -> P.text "[markdown| ... |]"
98instance Pretty (Def t v) where
99 pretty def =
100 case def of
101 TypeAnnotation name tipe ->
102 P.text name <+> P.text ":" <+> pretty tipe
103 Def pattern expr ->
104 pretty pattern <+> P.text "=" <+> pretty expr
106collectApps lexpr@(Location.L _ _ expr) =
107 case expr of
108 App a b -> collectApps a ++ [b]
109 _ -> [lexpr]
111collectLambdas lexpr@(Location.L _ _ expr) =
112 case expr of
113 Lambda pattern body ->
114 let (ps, body') = collectLambdas body
115 in (pretty pattern : ps, body')
116 _ -> ([], lexpr)
118prettyParens (Location.L _ _ expr) = parensIf needed (pretty expr)
119 where
120 needed =
121 case expr of
122 Binop _ _ _ -> True
123 Lambda _ _ -> True
124 App _ _ -> True
125 MultiIf _ -> True
126 Let _ _ -> True
127 Case _ _ -> True
128 Data name (x:xs) -> name /= "::"
129 _ -> False