git.iko.soy/elk
on 552becc help sign in
elk/src/AST/Expression/General.hs
248 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
13import AST.Type (Type)
15import qualified AST.Annotation as Annotation
16import qualified AST.Helpers as Help
17import qualified AST.Literal as Literal
18import qualified AST.Pattern as Pattern
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 | Input String (Type var)
62 | Output String (Type var) (Expr ann def var)
63 | LoopbackIn String Source
64 | LoopbackOut String (Expr ann def var)
65 | GLShader String String Literal.GLShaderTipe
66 deriving (Show)
69data Source
70 = Address
71 | PromiseStream
72 deriving (Show)
75---- UTILITIES ----
77rawVar :: String -> Expr' ann def Var.Raw
78rawVar x =
79 Var (Var.Raw x)
82localVar :: String -> Expr' ann def Var.Canonical
83localVar x =
84 Var (Var.Canonical Var.Local x)
87tuple :: [Expr ann def var] -> Expr' ann def var
88tuple expressions =
89 Data ("_Tuple" ++ show (length expressions)) expressions
92saveEnvName :: String
93saveEnvName =
94 "_save_the_environment!!!"
97dummyLet :: (Pretty def) => [def] -> Expr Annotation.Region def Var.Canonical
98dummyLet defs =
99 Annotation.none $ Let defs (Annotation.none $ Var (Var.builtin saveEnvName))
102instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var) where
103 pretty expr =
104 case expr of
105 Literal lit ->
106 pretty lit
108 Var x ->
109 pretty x
111 Range e1 e2 ->
112 P.brackets (pretty e1 <> P.text ".." <> pretty e2)
114 ExplicitList es ->
115 P.brackets (commaCat (map pretty es))
117 Binop op (Annotation.A _ (Literal (Literal.IntNum 0))) e
118 | Var.toString op == "-" ->
119 P.text "-" <> prettyParens e
121 Binop op e1 e2 ->
122 P.hang (prettyParens e1) 2 (P.text op'' <+> prettyParens e2)
123 where
124 op' = Var.toString op
125 op'' = if Help.isOp op' then op' else "`" ++ op' ++ "`"
127 Lambda p e ->
128 P.text "\\" <> args <+> P.text "->" <+> pretty body
129 where
130 (ps,body) = collectLambdas (Annotation.A undefined $ Lambda p e)
131 args = P.sep (map Pattern.prettyParens ps)
133 App _ _ ->
134 P.hang func 2 (P.sep args)
135 where
136 func:args =
137 map prettyParens (collectApps (Annotation.A undefined expr))
139 MultiIf branches ->
140 P.text "if" $$ nest 3 (vcat $ map iff branches)
141 where
142 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
144 Let defs e ->
145 P.sep
146 [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
147 , P.text "in" <+> pretty e
148 ]
150 Case e pats ->
151 P.hang pexpr 2 (P.vcat (map pretty' pats))
152 where
153 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
154 pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
156 Data "::" [hd,tl] ->
157 pretty hd <+> P.text "::" <+> pretty tl
159 Data "[]" [] ->
160 P.text "[]"
162 Data name es
163 | Help.isTuple name ->
164 P.parens (commaCat (map pretty es))
165 | otherwise ->
166 P.hang (P.text name) 2 (P.sep (map prettyParens es))
168 Access e x ->
169 prettyParens e <> P.text "." <> variable x
171 Remove e x ->
172 P.braces (pretty e <+> P.text "-" <+> variable x)
174 Insert (Annotation.A _ (Remove e y)) x v ->
175 P.braces $
176 P.hsep
177 [ pretty e, P.text "-", variable y, P.text "|"
178 , variable x, P.equals, pretty v
179 ]
181 Insert e x v ->
182 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
184 Modify e fs ->
185 P.braces $
186 P.hang
187 (pretty e <+> P.text "|")
188 4
189 (commaSep $ map field fs)
190 where
191 field (k,v) = variable k <+> P.text "<-" <+> pretty v
193 Record fs ->
194 P.sep
195 [ P.cat (zipWith (<+>) (P.lbrace : repeat P.comma) (map field fs))
196 , P.rbrace
197 ]
198 where
199 field (name, value) =
200 variable name <+> P.equals <+> pretty value
202 GLShader _ _ _ ->
203 P.text "[glsl| ... |]"
205 Input name _ ->
206 P.text ("<input:" ++ name ++ ">")
208 Output name _ _ ->
209 P.text ("<output:" ++ name ++ ">")
211 LoopbackIn name _ ->
212 P.text ("<loopback-in:" ++ name ++ ">")
214 LoopbackOut name _ ->
215 P.text ("<loopback-out:" ++ name ++ ">")
218collectApps :: Expr ann def var -> [Expr ann def var]
219collectApps annExpr@(Annotation.A _ expr) =
220 case expr of
221 App a b -> collectApps a ++ [b]
222 _ -> [annExpr]
225collectLambdas :: Expr ann def var -> ([Pattern.Pattern var], Expr ann def var)
226collectLambdas lexpr@(Annotation.A _ expr) =
227 case expr of
228 Lambda pattern body ->
229 let (ps, body') = collectLambdas body
230 in (pattern : ps, body')
232 _ -> ([], lexpr)
235prettyParens :: (Pretty def, Pretty var, Var.ToString var) => Expr ann def var -> Doc
236prettyParens (Annotation.A _ expr) =
237 parensIf needed (pretty expr)
238 where
239 needed =
240 case expr of
241 Binop _ _ _ -> True
242 Lambda _ _ -> True
243 App _ _ -> True
244 MultiIf _ -> True
245 Let _ _ -> True
246 Case _ _ -> True
247 Data name (_:_) -> not (name == "::" || Help.isTuple name)
248 _ -> False