git.iko.soy/elk
on cf3a0bd help sign in
elk/src/AST/Expression/General.hs
253 lines 7.7 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 (PortImpl (Expr ann def var) var)
62 | GLShader String String Literal.GLShaderTipe
63 deriving (Show)
66-- PORTS
68data PortImpl expr var
69 = In String (Type.PortType var)
70 | Out String expr (Type.PortType var)
71 | Task String expr (Type.PortType var)
72 deriving (Show)
75portName :: PortImpl expr var -> String
76portName impl =
77 case impl of
78 In name _ -> name
79 Out name _ _ -> name
80 Task name _ _ -> name
83---- UTILITIES ----
85rawVar :: String -> Expr' ann def Var.Raw
86rawVar x =
87 Var (Var.Raw x)
90localVar :: String -> Expr' ann def Var.Canonical
91localVar x =
92 Var (Var.Canonical Var.Local x)
95tuple :: [Expr ann def var] -> Expr' ann def var
96tuple expressions =
97 Data ("_Tuple" ++ show (length expressions)) expressions
100saveEnvName :: String
101saveEnvName =
102 "_save_the_environment!!!"
105dummyLet :: (Pretty def) => [def] -> Expr Annotation.Region def Var.Canonical
106dummyLet defs =
107 Annotation.none $ Let defs (Annotation.none $ Var (Var.builtin saveEnvName))
110instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var) where
111 pretty expression =
112 case expression of
113 Literal literal ->
114 pretty literal
116 Var x ->
117 pretty x
119 Range lowExpr highExpr ->
120 P.brackets (pretty lowExpr <> P.text ".." <> pretty highExpr)
122 ExplicitList elements ->
123 P.brackets (commaCat (map pretty elements))
125 Binop op (Annotation.A _ (Literal (Literal.IntNum 0))) expr
126 | Var.toString op == "-" ->
127 P.text "-" <> prettyParens expr
129 Binop op leftExpr rightExpr ->
130 P.hang (prettyParens leftExpr) 2 (P.text op'' <+> prettyParens rightExpr)
131 where
132 op' = Var.toString op
133 op'' = if Help.isOp op' then op' else "`" ++ op' ++ "`"
135 Lambda pattern expr ->
136 P.text "\\" <> args <+> P.text "->" <+> pretty body
137 where
138 (patterns, body) = collectLambdas expr
139 args = P.sep (map Pattern.prettyParens (pattern : patterns))
141 App expr arg ->
142 P.hang func 2 (P.sep args)
143 where
144 func:args =
145 map prettyParens (collectApps expr ++ [arg])
147 MultiIf branches ->
148 P.text "if" $$ nest 3 (vcat $ map iff branches)
149 where
150 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
152 Let defs body ->
153 P.sep
154 [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
155 , P.text "in" <+> pretty body
156 ]
158 Case expr branches ->
159 P.hang pexpr 2 (P.vcat (map pretty' branches))
160 where
161 pexpr = P.sep [ P.text "case" <+> pretty expr, P.text "of" ]
162 pretty' (pattern, branch) =
163 pretty pattern <+> P.text "->" <+> pretty branch
165 Data "::" [hd,tl] ->
166 pretty hd <+> P.text "::" <+> pretty tl
168 Data "[]" [] ->
169 P.text "[]"
171 Data name exprs
172 | Help.isTuple name ->
173 P.parens (commaCat (map pretty exprs))
174 | otherwise ->
175 P.hang (P.text name) 2 (P.sep (map prettyParens exprs))
177 Access record field ->
178 prettyParens record <> P.text "." <> variable field
180 Remove record field ->
181 P.braces (pretty record <+> P.text "-" <+> variable field)
183 Insert (Annotation.A _ (Remove record y)) x v ->
184 P.braces $
185 P.hsep
186 [ pretty record, P.text "-", variable y, P.text "|"
187 , variable x, P.equals, pretty v
188 ]
190 Insert record field expr ->
191 P.braces (pretty record <+> P.text "|" <+> variable field <+> P.equals <+> pretty expr)
193 Modify record fields ->
194 P.braces $
195 P.hang
196 (pretty record <+> P.text "|")
197 4
198 (commaSep $ map field fields)
199 where
200 field (k,v) = variable k <+> P.text "<-" <+> pretty v
202 Record fields ->
203 P.sep
204 [ P.cat (zipWith (<+>) (P.lbrace : repeat P.comma) (map field fields))
205 , P.rbrace
206 ]
207 where
208 field (name, expr) =
209 variable name <+> P.equals <+> pretty expr
211 GLShader _ _ _ ->
212 P.text "[glsl| ... |]"
214 Port portImpl ->
215 pretty portImpl
218instance (Pretty expr, Pretty var) => Pretty (PortImpl expr var) where
219 pretty impl =
220 P.text ("<port:" ++ portName impl ++ ">")
223collectApps :: Expr ann def var -> [Expr ann def var]
224collectApps annExpr@(Annotation.A _ expr) =
225 case expr of
226 App a b -> collectApps a ++ [b]
227 _ -> [annExpr]
230collectLambdas :: Expr ann def var -> ([Pattern.Pattern var], Expr ann def var)
231collectLambdas lexpr@(Annotation.A _ expr) =
232 case expr of
233 Lambda pattern body ->
234 let (ps, body') = collectLambdas body
235 in (pattern : ps, body')
237 _ -> ([], lexpr)
240prettyParens :: (Pretty def, Pretty var, Var.ToString var) => Expr ann def var -> Doc
241prettyParens (Annotation.A _ expr) =
242 parensIf needed (pretty expr)
243 where
244 needed =
245 case expr of
246 Binop _ _ _ -> True
247 Lambda _ _ -> True
248 App _ _ -> True
249 MultiIf _ -> True
250 Let _ _ -> True
251 Case _ _ -> True
252 Data name (_:_) -> not (name == "::" || Help.isTuple name)
253 _ -> False