git.iko.soy/elk
on 2ec798e help sign in
elk/src/AST/Expression/General.hs
234 lines 7.1 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 | PortIn String (Type var)
62 | PortOut String (Type var) (Expr ann def var)
63 | GLShader String String Literal.GLShaderTipe
64 deriving (Show)
67---- UTILITIES ----
69rawVar :: String -> Expr' ann def Var.Raw
70rawVar x =
71 Var (Var.Raw x)
74localVar :: String -> Expr' ann def Var.Canonical
75localVar x =
76 Var (Var.Canonical Var.Local x)
79tuple :: [Expr ann def var] -> Expr' ann def var
80tuple expressions =
81 Data ("_Tuple" ++ show (length expressions)) expressions
84saveEnvName :: String
85saveEnvName =
86 "_save_the_environment!!!"
89dummyLet :: (Pretty def) => [def] -> Expr Annotation.Region def Var.Canonical
90dummyLet defs =
91 Annotation.none $ Let defs (Annotation.none $ Var (Var.builtin saveEnvName))
94instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var) where
95 pretty expr =
96 case expr of
97 Literal lit ->
98 pretty lit
100 Var x ->
101 pretty x
103 Range e1 e2 ->
104 P.brackets (pretty e1 <> P.text ".." <> pretty e2)
106 ExplicitList es ->
107 P.brackets (commaCat (map pretty es))
109 Binop op (Annotation.A _ (Literal (Literal.IntNum 0))) e
110 | Var.toString op == "-" ->
111 P.text "-" <> prettyParens e
113 Binop op e1 e2 ->
114 P.hang (prettyParens e1) 2 (P.text op'' <+> prettyParens e2)
115 where
116 op' = Var.toString op
117 op'' = if Help.isOp op' then op' else "`" ++ op' ++ "`"
119 Lambda p e ->
120 P.text "\\" <> args <+> P.text "->" <+> pretty body
121 where
122 (ps,body) = collectLambdas (Annotation.A undefined $ Lambda p e)
123 args = P.sep (map Pattern.prettyParens ps)
125 App _ _ ->
126 P.hang func 2 (P.sep args)
127 where
128 func:args =
129 map prettyParens (collectApps (Annotation.A undefined expr))
131 MultiIf branches ->
132 P.text "if" $$ nest 3 (vcat $ map iff branches)
133 where
134 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
136 Let defs e ->
137 P.sep
138 [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
139 , P.text "in" <+> pretty e
140 ]
142 Case e pats ->
143 P.hang pexpr 2 (P.vcat (map pretty' pats))
144 where
145 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
146 pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
148 Data "::" [hd,tl] ->
149 pretty hd <+> P.text "::" <+> pretty tl
151 Data "[]" [] ->
152 P.text "[]"
154 Data name es
155 | Help.isTuple name ->
156 P.parens (commaCat (map pretty es))
157 | otherwise ->
158 P.hang (P.text name) 2 (P.sep (map prettyParens es))
160 Access e x ->
161 prettyParens e <> P.text "." <> variable x
163 Remove e x ->
164 P.braces (pretty e <+> P.text "-" <+> variable x)
166 Insert (Annotation.A _ (Remove e y)) x v ->
167 P.braces $
168 P.hsep
169 [ pretty e, P.text "-", variable y, P.text "|"
170 , variable x, P.equals, pretty v
171 ]
173 Insert e x v ->
174 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
176 Modify e fs ->
177 P.braces $
178 P.hang
179 (pretty e <+> P.text "|")
180 4
181 (commaSep $ map field fs)
182 where
183 field (k,v) = variable k <+> P.text "<-" <+> pretty v
185 Record fs ->
186 P.sep
187 [ P.cat (zipWith (<+>) (P.lbrace : repeat P.comma) (map field fs))
188 , P.rbrace
189 ]
190 where
191 field (field, value) =
192 variable field <+> P.equals <+> pretty value
194 GLShader _ _ _ ->
195 P.text "[glsl| ... |]"
197 PortIn name _ ->
198 P.text $ "<port:" ++ name ++ ">"
200 PortOut _ _ signal ->
201 pretty signal
204collectApps :: Expr ann def var -> [Expr ann def var]
205collectApps annExpr@(Annotation.A _ expr) =
206 case expr of
207 App a b -> collectApps a ++ [b]
208 _ -> [annExpr]
211collectLambdas :: Expr ann def var -> ([Pattern.Pattern var], Expr ann def var)
212collectLambdas lexpr@(Annotation.A _ expr) =
213 case expr of
214 Lambda pattern body ->
215 let (ps, body') = collectLambdas body
216 in (pattern : ps, body')
218 _ -> ([], lexpr)
221prettyParens :: (Pretty def, Pretty var, Var.ToString var) => Expr ann def var -> Doc
222prettyParens (Annotation.A _ expr) =
223 parensIf needed (pretty expr)
224 where
225 needed =
226 case expr of
227 Binop _ _ _ -> True
228 Lambda _ _ -> True
229 App _ _ -> True
230 MultiIf _ -> True
231 Let _ _ -> True
232 Case _ _ -> True
233 Data name (_:_) -> not (name == "::" || Help.isTuple name)
234 _ -> False