git.iko.soy/elk
on 21ccfbc help sign in
elk/src/AST/Expression/General.hs
237 lines 7.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
3{-| The Abstract Syntax Tree (AST) for expressions comes in a couple formats.
4The first is the fully general version and is labeled with a prime (Expr').
5The others are specialized versions of the AST that represent specific phases
6of the compilation process. I expect there to be more phases as we begin to
7enrich the AST with more information.
8-}
9module AST.Expression.General where
11import AST.PrettyPrint
12import Text.PrettyPrint as P
14import qualified AST.Annotation as Annotation
15import qualified AST.Helpers as Help
16import qualified AST.Literal as Literal
17import qualified AST.Pattern as Pattern
18import qualified AST.Type as Type
19import qualified AST.Variable as Var
22---- GENERAL AST ----
24{-| This is a fully general Abstract Syntax Tree (AST) for expressions. It has
25"type holes" that allow us to enrich the AST with additional information as we
26move through the compilation process. The type holes are used to represent:
28 ann: Annotations for arbitrary expressions. Allows you to add information
29 to the AST like position in source code or inferred types.
31 def: Definition style. The source syntax separates type annotations and
32 definitions, but after parsing we check that they are well formed and
33 collapse them.
35 var: Representation of variables. Starts as strings, but is later enriched
36 with information about what module a variable came from.
38-}
39type Expr annotation definition variable =
40 Annotation.Annotated annotation (Expr' annotation definition variable)
43data Expr' ann def var
44 = Literal Literal.Literal
45 | Var var
46 | Range (Expr ann def var) (Expr ann def var)
47 | ExplicitList [Expr ann def var]
48 | Binop var (Expr ann def var) (Expr ann def var)
49 | Lambda (Pattern.Pattern var) (Expr ann def var)
50 | App (Expr ann def var) (Expr ann def var)
51 | MultiIf [(Expr ann def var,Expr ann def var)]
52 | Let [def] (Expr ann def var)
53 | Case (Expr ann def var) [(Pattern.Pattern var, Expr ann def var)]
54 | Data String [Expr ann def var]
55 | Access (Expr ann def var) String
56 | Remove (Expr ann def var) String
57 | Insert (Expr ann def var) String (Expr ann def var)
58 | Modify (Expr ann def var) [(String, Expr ann def var)]
59 | Record [(String, Expr ann def var)]
60 -- for type checking and code gen only
61 | Port String (PortImpl (Expr ann def var) var)
62 | GLShader String String Literal.GLShaderTipe
63 deriving (Show)
66data PortImpl expr var
67 = Inbound (Type.PortType var)
68 | Outbound (Type.PortType var) expr
69 deriving (Show)
72---- UTILITIES ----
74rawVar :: String -> Expr' ann def Var.Raw
75rawVar x =
76 Var (Var.Raw x)
79localVar :: String -> Expr' ann def Var.Canonical
80localVar x =
81 Var (Var.Canonical Var.Local x)
84tuple :: [Expr ann def var] -> Expr' ann def var
85tuple expressions =
86 Data ("_Tuple" ++ show (length expressions)) expressions
89saveEnvName :: String
90saveEnvName =
91 "_save_the_environment!!!"
94dummyLet :: (Pretty def) => [def] -> Expr Annotation.Region def Var.Canonical
95dummyLet defs =
96 Annotation.none $ Let defs (Annotation.none $ Var (Var.builtin saveEnvName))
99instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var) where
100 pretty expression =
101 case expression of
102 Literal literal ->
103 pretty literal
105 Var x ->
106 pretty x
108 Range lowExpr highExpr ->
109 P.brackets (pretty lowExpr <> P.text ".." <> pretty highExpr)
111 ExplicitList elements ->
112 P.brackets (commaCat (map pretty elements))
114 Binop op (Annotation.A _ (Literal (Literal.IntNum 0))) expr
115 | Var.toString op == "-" ->
116 P.text "-" <> prettyParens expr
118 Binop op leftExpr rightExpr ->
119 P.hang (prettyParens leftExpr) 2 (P.text op'' <+> prettyParens rightExpr)
120 where
121 op' = Var.toString op
122 op'' = if Help.isOp op' then op' else "`" ++ op' ++ "`"
124 Lambda pattern expr ->
125 P.text "\\" <> args <+> P.text "->" <+> pretty body
126 where
127 (patterns, body) = collectLambdas expr
128 args = P.sep (map Pattern.prettyParens (pattern : patterns))
130 App expr arg ->
131 P.hang func 2 (P.sep args)
132 where
133 func:args =
134 map prettyParens (collectApps expr ++ [arg])
136 MultiIf branches ->
137 P.text "if" $$ nest 3 (vcat $ map iff branches)
138 where
139 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
141 Let defs body ->
142 P.sep
143 [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
144 , P.text "in" <+> pretty body
145 ]
147 Case expr branches ->
148 P.hang pexpr 2 (P.vcat (map pretty' branches))
149 where
150 pexpr = P.sep [ P.text "case" <+> pretty expr, P.text "of" ]
151 pretty' (pattern, branch) =
152 pretty pattern <+> P.text "->" <+> pretty branch
154 Data "::" [hd,tl] ->
155 pretty hd <+> P.text "::" <+> pretty tl
157 Data "[]" [] ->
158 P.text "[]"
160 Data name exprs
161 | Help.isTuple name ->
162 P.parens (commaCat (map pretty exprs))
163 | otherwise ->
164 P.hang (P.text name) 2 (P.sep (map prettyParens exprs))
166 Access record field ->
167 prettyParens record <> P.text "." <> variable field
169 Remove record field ->
170 P.braces (pretty record <+> P.text "-" <+> variable field)
172 Insert (Annotation.A _ (Remove record y)) x v ->
173 P.braces $
174 P.hsep
175 [ pretty record, P.text "-", variable y, P.text "|"
176 , variable x, P.equals, pretty v
177 ]
179 Insert record field expr ->
180 P.braces (pretty record <+> P.text "|" <+> variable field <+> P.equals <+> pretty expr)
182 Modify record fields ->
183 P.braces $
184 P.hang
185 (pretty record <+> P.text "|")
186 4
187 (commaSep $ map field fields)
188 where
189 field (k,v) = variable k <+> P.text "<-" <+> pretty v
191 Record fields ->
192 P.sep
193 [ P.cat (zipWith (<+>) (P.lbrace : repeat P.comma) (map field fields))
194 , P.rbrace
195 ]
196 where
197 field (name, expr) =
198 variable name <+> P.equals <+> pretty expr
200 GLShader _ _ _ ->
201 P.text "[glsl| ... |]"
203 Port name _ ->
204 P.text ("<port:" ++ name ++ ">")
207collectApps :: Expr ann def var -> [Expr ann def var]
208collectApps annExpr@(Annotation.A _ expr) =
209 case expr of
210 App a b -> collectApps a ++ [b]
211 _ -> [annExpr]
214collectLambdas :: Expr ann def var -> ([Pattern.Pattern var], Expr ann def var)
215collectLambdas lexpr@(Annotation.A _ expr) =
216 case expr of
217 Lambda pattern body ->
218 let (ps, body') = collectLambdas body
219 in (pattern : ps, body')
221 _ -> ([], lexpr)
224prettyParens :: (Pretty def, Pretty var, Var.ToString var) => Expr ann def var -> Doc
225prettyParens (Annotation.A _ expr) =
226 parensIf needed (pretty expr)
227 where
228 needed =
229 case expr of
230 Binop _ _ _ -> True
231 Lambda _ _ -> True
232 App _ _ -> True
233 MultiIf _ -> True
234 Let _ _ -> True
235 Case _ _ -> True
236 Data name (_:_) -> not (name == "::" || Help.isTuple name)
237 _ -> False