git.iko.soy/elk
on d87affe help sign in
elk/src/AST/Expression/General.hs
221 lines 7.2 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
21---- GENERAL AST ----
23{-| This is a fully general Abstract Syntax Tree (AST) for expressions. It has
24"type holes" that allow us to enrich the AST with additional information as we
25move through the compilation process. The type holes are used to represent:
27 ann: Annotations for arbitrary expressions. Allows you to add information
28 to the AST like position in source code or inferred types.
30 def: Definition style. The source syntax separates type annotations and
31 definitions, but after parsing we check that they are well formed and
32 collapse them.
34 var: Representation of variables. Starts as strings, but is later enriched
35 with information about what module a variable came from.
37-}
38type Expr annotation definition variable =
39 Annotation.Annotated annotation (Expr' annotation definition variable)
41data Expr' ann def var
42 = Literal Literal.Literal
43 | Var var
44 | Range (Expr ann def var) (Expr ann def var)
45 | ExplicitList [Expr ann def var]
46 | Binop var (Expr ann def var) (Expr ann def var)
47 | Lambda (Pattern.Pattern var) (Expr ann def var)
48 | App (Expr ann def var) (Expr ann def var)
49 | MultiIf [(Expr ann def var,Expr ann def var)]
50 | Let [def] (Expr ann def var)
51 | Case (Expr ann def var) [(Pattern.Pattern var, Expr ann def var)]
52 | Data String [Expr ann def var]
53 | Access (Expr ann def var) String
54 | Remove (Expr ann def var) String
55 | Insert (Expr ann def var) String (Expr ann def var)
56 | Modify (Expr ann def var) [(String, Expr ann def var)]
57 | Record [(String, Expr ann def var)]
58 | Markdown String String
59 -- for type checking and code gen only
60 | PortIn String (Type var)
61 | PortOut String (Type var) (Expr ann def var)
62 | GLShader String String Literal.GLShaderTipe
63 deriving (Show)
66---- UTILITIES ----
68rawVar :: String -> Expr' ann def Var.Raw
69rawVar x = Var (Var.Raw x)
71localVar :: String -> Expr' ann def Var.Canonical
72localVar x = Var (Var.Canonical Var.Local x)
74tuple :: [Expr ann def var] -> Expr' ann def var
75tuple es = Data ("_Tuple" ++ show (length es)) es
77delist :: Expr ann def var -> [Expr ann def var]
78delist (Annotation.A _ (Data "::" [h,t])) = h : delist t
79delist _ = []
81saveEnvName :: String
82saveEnvName = "_save_the_environment!!!"
84dummyLet :: (Pretty def) => [def] -> Expr Annotation.Region def Var.Canonical
85dummyLet defs =
86 Annotation.none $ Let defs (Annotation.none $ Var (Var.builtin saveEnvName))
88instance (Pretty def, Pretty var, Var.ToString var) => Pretty (Expr' ann def var) where
89 pretty expr =
90 case expr of
91 Literal lit ->
92 pretty lit
94 Var x ->
95 pretty x
97 Range e1 e2 ->
98 P.brackets (pretty e1 <> P.text ".." <> pretty e2)
100 ExplicitList es ->
101 P.brackets (commaCat (map pretty es))
103 Binop op (Annotation.A _ (Literal (Literal.IntNum 0))) e
104 | Var.toString op == "-" ->
105 P.text "-" <> prettyParens e
107 Binop op e1 e2 ->
108 P.hang (prettyParens e1) 2 (P.text op'' <+> prettyParens e2)
109 where
110 op' = Var.toString op
111 op'' = if Help.isOp op' then op' else "`" ++ op' ++ "`"
113 Lambda p e ->
114 P.text "\\" <> args <+> P.text "->" <+> pretty body
115 where
116 (ps,body) = collectLambdas (Annotation.A undefined $ Lambda p e)
117 args = P.sep (map Pattern.prettyParens ps)
119 App _ _ ->
120 P.hang func 2 (P.sep args)
121 where
122 func:args =
123 map prettyParens (collectApps (Annotation.A undefined expr))
125 MultiIf branches ->
126 P.text "if" $$ nest 3 (vcat $ map iff branches)
127 where
128 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
130 Let defs e ->
131 P.sep
132 [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
133 , P.text "in" <+> pretty e
134 ]
136 Case e pats ->
137 P.hang pexpr 2 (P.vcat (map pretty' pats))
138 where
139 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
140 pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
142 Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
143 Data "[]" [] -> P.text "[]"
144 Data name es
145 | Help.isTuple name -> P.parens (commaCat (map pretty es))
146 | otherwise -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
148 Access e x ->
149 prettyParens e <> P.text "." <> variable x
151 Remove e x ->
152 P.braces (pretty e <+> P.text "-" <+> variable x)
154 Insert (Annotation.A _ (Remove e y)) x v ->
155 P.braces $
156 P.hsep
157 [ pretty e, P.text "-", variable y, P.text "|"
158 , variable x, P.equals, pretty v
159 ]
161 Insert e x v ->
162 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
164 Modify e fs ->
165 P.braces $
166 P.hang
167 (pretty e <+> P.text "|")
168 4
169 (commaSep $ map field fs)
170 where
171 field (k,v) = variable k <+> P.text "<-" <+> pretty v
173 Record fs ->
174 P.sep
175 [ P.cat (zipWith (<+>) (P.lbrace : repeat P.comma) (map field fs))
176 , P.rbrace
177 ]
178 where
179 field (field, value) =
180 variable field <+> P.equals <+> pretty value
182 Markdown _ _ -> P.text "[markdown| ... |]"
184 GLShader _ _ _ -> P.text "[glsl| ... |]"
186 PortIn name _ -> P.text $ "<port:" ++ name ++ ">"
188 PortOut _ _ signal -> pretty signal
191collectApps :: Expr ann def var -> [Expr ann def var]
192collectApps annExpr@(Annotation.A _ expr) =
193 case expr of
194 App a b -> collectApps a ++ [b]
195 _ -> [annExpr]
198collectLambdas :: Expr ann def var -> ([Pattern.Pattern var], Expr ann def var)
199collectLambdas lexpr@(Annotation.A _ expr) =
200 case expr of
201 Lambda pattern body ->
202 let (ps, body') = collectLambdas body
203 in (pattern : ps, body')
205 _ -> ([], lexpr)
208prettyParens :: (Pretty def, Pretty var, Var.ToString var) => Expr ann def var -> Doc
209prettyParens (Annotation.A _ expr) =
210 parensIf needed (pretty expr)
211 where
212 needed =
213 case expr of
214 Binop _ _ _ -> True
215 Lambda _ _ -> True
216 App _ _ -> True
217 MultiIf _ -> True
218 Let _ _ -> True
219 Case _ _ -> True
220 Data name (_:_) -> not (name == "::" || Help.isTuple name)
221 _ -> False