git.iko.soy/elk
on bdeb36e help sign in
elk/compiler/SourceSyntax/Expression.hs
173 lines 6.2 kB history raw
1module SourceSyntax.Expression where
3import Data.List (intercalate)
4import SourceSyntax.PrettyPrint
5import Text.PrettyPrint as P
6import qualified SourceSyntax.Helpers as Help
7import qualified SourceSyntax.Location as Location
8import qualified SourceSyntax.Pattern as Pattern
9import qualified SourceSyntax.Type as Type
10import qualified SourceSyntax.Literal as Literal
12{-| This is a located expression. -}
13type LExpr' def = Location.Located (Expr' def)
15{-| This is a fully general expression. The compilation process will enrich
16this data structure with additional information after the initial parse.
17The type holes let us reflect these structural changes in the types.
19 def: Parsing allows two kinds of definitions (type annotations or definitions),
20 but later checks will see that they are well formed and combine them.
22 t: for adding type information, currently unused
24 v: for enriching variables with information like provenonce, currently unused
26Please don't get on my case to take the unused ones out. I have considered it.
27It's a huge pain to add and remove, it will get used eventually, and it's not
28hurting anything as it is.
29-}
30data Expr' def
31 = Literal Literal.Literal
32 | Var String
33 | Range (LExpr' def) (LExpr' def)
34 | ExplicitList [LExpr' def]
35 | Binop String (LExpr' def) (LExpr' def)
36 | Lambda Pattern.Pattern (LExpr' def)
37 | App (LExpr' def) (LExpr' def)
38 | MultiIf [(LExpr' def,LExpr' def)]
39 | Let [def] (LExpr' def)
40 | Case (LExpr' def) [(Pattern.Pattern, LExpr' def)]
41 | Data String [LExpr' def]
42 | Access (LExpr' def) String
43 | Remove (LExpr' def) String
44 | Insert (LExpr' def) String (LExpr' def)
45 | Modify (LExpr' def) [(String, LExpr' def)]
46 | Record [(String, LExpr' def)]
47 | Markdown String String [LExpr' def]
48 deriving (Eq)
50type ParseExpr = Expr' ParseDef
51type LParseExpr = LExpr' ParseDef
52type LExpr = LExpr' Def
53type Expr = Expr' Def
55{-| Style of definitions as they are parsed. Users specify them
56separately, and other checks will make sure they can be combined.
57-}
58data ParseDef
59 = Def Pattern.Pattern LParseExpr
60 | TypeAnnotation String Type.Type
61 deriving (Eq, Show)
63{-| After checking that type annotations and definitions are all
64valid, they can be combined.
65-}
66data Def
67 = Definition Pattern.Pattern (LExpr' Def) (Maybe Type.Type)
68 deriving (Eq, Show)
70tuple es = Data ("_Tuple" ++ show (length es)) es
72delist (Location.L _ (Data "::" [h,t])) = h : delist t
73delist _ = []
75saveEnvName = "_save_the_environment!!!"
77dummyLet defs =
78 Location.none $ Let defs (Location.none $ Var saveEnvName)
80instance Pretty def => Show (Expr' def) where
81 show = render . pretty
83instance Pretty def => Pretty (Expr' def) where
84 pretty expr =
85 case expr of
86 Literal lit -> pretty lit
87 Var x -> variable x
88 Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)
89 ExplicitList es -> P.brackets (commaCat (map pretty es))
90 Binop "-" (Location.L _ (Literal (Literal.IntNum 0))) e ->
91 P.text "-" <> prettyParens e
92 Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op', prettyParens e2 ]
93 where op' = if Help.isOp op then op else "`" ++ op ++ "`"
94 Lambda p e -> let (ps,body) = collectLambdas (Location.none $ Lambda p e)
95 in P.text "\\" <> P.sep ps <+> P.text "->" <+> pretty body
96 App _ _ -> P.hang func 2 (P.sep args)
97 where func:args = map prettyParens (collectApps (Location.none expr))
98 MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
99 where
100 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
101 Let defs e ->
102 P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
103 , P.text "in" <+> pretty e ]
104 Case e pats ->
105 P.hang pexpr 2 (P.vcat (map pretty' pats))
106 where
107 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
108 pretty' (p,e) = pretty p <+> P.text "->" <+> pretty e
109 Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
110 Data "[]" [] -> P.text "[]"
111 Data name es -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
112 Access e x -> prettyParens e <> P.text "." <> variable x
113 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
114 Insert (Location.L _ (Remove e y)) x v ->
115 P.braces (pretty e <+> P.text "-" <+> variable y <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
116 Insert e x v ->
117 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
119 Modify e fs ->
120 P.braces $ P.hang (pretty e <+> P.text "|")
121 4
122 (commaSep $ map field fs)
123 where
124 field (x,e) = variable x <+> P.text "<-" <+> pretty e
126 Record fs ->
127 P.braces $ P.nest 2 (commaSep $ map field fs)
128 where
129 field (x,e) = variable x <+> P.equals <+> pretty e
131 Markdown _ _ _ -> P.text "[markdown| ... |]"
133instance Pretty ParseDef where
134 pretty def =
135 case def of
136 TypeAnnotation name tipe ->
137 variable name <+> P.colon <+> pretty tipe
138 Def pattern expr ->
139 pretty pattern <+> P.equals <+> pretty expr
141instance Pretty Def where
142 pretty (Definition pattern expr maybeTipe) =
143 P.vcat [ annotation, definition ]
144 where
145 definition = pretty pattern <+> P.equals <+> pretty expr
146 annotation = case maybeTipe of
147 Nothing -> P.empty
148 Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
150collectApps lexpr@(Location.L _ expr) =
151 case expr of
152 App a b -> collectApps a ++ [b]
153 _ -> [lexpr]
155collectLambdas lexpr@(Location.L _ expr) =
156 case expr of
157 Lambda pattern body ->
158 let (ps, body') = collectLambdas body
159 in (pretty pattern : ps, body')
160 _ -> ([], lexpr)
162prettyParens (Location.L _ expr) = parensIf needed (pretty expr)
163 where
164 needed =
165 case expr of
166 Binop _ _ _ -> True
167 Lambda _ _ -> True
168 App _ _ -> True
169 MultiIf _ -> True
170 Let _ _ -> True
171 Case _ _ -> True
172 Data name (x:xs) -> name /= "::"
173 _ -> False