git.iko.soy/elk
on 56febaf help sign in
elk/compiler/SourceSyntax/Expression.hs
232 lines 8.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 SourceSyntax.Expression where
11import SourceSyntax.PrettyPrint
12import Text.PrettyPrint as P
13import qualified SourceSyntax.Helpers as Help
14import qualified SourceSyntax.Annotation as Annotation
15import qualified SourceSyntax.Pattern as Pattern
16import qualified SourceSyntax.Type as SrcType
17import qualified SourceSyntax.Literal as Literal
18import qualified SourceSyntax.Variable as Variable
20---- GENERAL AST ----
22{-| This is a fully general Abstract Syntax Tree (AST) for expressions. It has
23"type holes" that allow us to enrich the AST with additional information as we
24move through the compilation process. The type holes are used to represent:
26 ann: Annotations for arbitrary expressions. Allows you to add information
27 to the AST like position in source code or inferred types.
29 def: Definition style. The source syntax separates type annotations and
30 definitions, but after parsing we check that they are well formed and
31 collapse them.
33 var: Representation of variables. Starts as strings, but is later enriched
34 with information about what module a variable came from.
36-}
37type GeneralExpr annotation definition variable =
38 Annotation.Annotated annotation (GeneralExpr' annotation definition variable)
40data GeneralExpr' ann def var
41 = Literal Literal.Literal
42 | Var var
43 | Range (GeneralExpr ann def var) (GeneralExpr ann def var)
44 | ExplicitList [GeneralExpr ann def var]
45 | Binop String (GeneralExpr ann def var) (GeneralExpr ann def var)
46 | Lambda Pattern.Pattern (GeneralExpr ann def var)
47 | App (GeneralExpr ann def var) (GeneralExpr ann def var)
48 | MultiIf [(GeneralExpr ann def var,GeneralExpr ann def var)]
49 | Let [def] (GeneralExpr ann def var)
50 | Case (GeneralExpr ann def var) [(Pattern.Pattern, GeneralExpr ann def var)]
51 | Data String [GeneralExpr ann def var]
52 | Access (GeneralExpr ann def var) String
53 | Remove (GeneralExpr ann def var) String
54 | Insert (GeneralExpr ann def var) String (GeneralExpr ann def var)
55 | Modify (GeneralExpr ann def var) [(String, GeneralExpr ann def var)]
56 | Record [(String, GeneralExpr ann def var)]
57 | Markdown String String [GeneralExpr ann def var]
58 -- for type checking and code gen only
59 | PortIn String SrcType.Type
60 | PortOut String SrcType.Type (GeneralExpr ann def var)
61 | GLShader String String Literal.GLShaderTipe
62 deriving (Show)
65---- SPECIALIZED ASTs ----
67{-| Expressions created by the parser. These use a split representation of type
68annotations and definitions, which is how they appear in source code and how
69they are parsed.
70-}
71type ParseExpr = GeneralExpr Annotation.Region ParseDef Variable.Raw
72type ParseExpr' = GeneralExpr' Annotation.Region ParseDef Variable.Raw
74data ParseDef
75 = Def Pattern.Pattern ParseExpr
76 | TypeAnnotation String SrcType.Type
77 deriving (Show)
79{-| "Normal" expressions. When the compiler checks that type annotations and
80ports are all paired with definitions in the appropriate order, it collapses
81them into a Def that is easier to work with in later phases of compilation.
82-}
83type Expr = GeneralExpr Annotation.Region Def Variable.Raw
84type Expr' = GeneralExpr' Annotation.Region Def Variable.Raw
86data Def = Definition Pattern.Pattern Expr (Maybe SrcType.Type)
87 deriving (Show)
91---- UTILITIES ----
93rawVar :: String -> GeneralExpr' ann def Variable.Raw
94rawVar x = Var (Variable.Raw x)
96tuple :: [GeneralExpr ann def var] -> GeneralExpr' ann def var
97tuple es = Data ("_Tuple" ++ show (length es)) es
99delist :: GeneralExpr ann def var -> [GeneralExpr ann def var]
100delist (Annotation.A _ (Data "::" [h,t])) = h : delist t
101delist _ = []
103saveEnvName :: String
104saveEnvName = "_save_the_environment!!!"
106dummyLet :: (Pretty def) => [def] -> GeneralExpr Annotation.Region def Variable.Raw
107dummyLet defs =
108 Annotation.none $ Let defs (Annotation.none $ rawVar saveEnvName)
110instance (Pretty def, Pretty var) => Pretty (GeneralExpr' ann def var) where
111 pretty expr =
112 case expr of
113 Literal lit -> pretty lit
115 Var x -> pretty x
117 Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)
119 ExplicitList es -> P.brackets (commaCat (map pretty es))
121 Binop "-" (Annotation.A _ (Literal (Literal.IntNum 0))) e ->
122 P.text "-" <> prettyParens e
124 Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op', prettyParens e2 ]
125 where
126 op' = if Help.isOp op then op else "`" ++ op ++ "`"
128 Lambda p e -> 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 _ _ -> P.hang func 2 (P.sep args)
134 where
135 func:args = map prettyParens (collectApps (Annotation.A undefined expr))
137 MultiIf branches -> 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 e ->
142 P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
143 , P.text "in" <+> pretty e ]
145 Case e pats ->
146 P.hang pexpr 2 (P.vcat (map pretty' pats))
147 where
148 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
149 pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
151 Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
152 Data "[]" [] -> P.text "[]"
153 Data name es
154 | Help.isTuple name -> P.parens (commaCat (map pretty es))
155 | otherwise -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
157 Access e x -> prettyParens e <> P.text "." <> variable x
159 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
161 Insert (Annotation.A _ (Remove e y)) x v ->
162 P.braces $ P.hsep [ pretty e, P.text "-", variable y, P.text "|"
163 , variable x, P.equals, pretty v ]
165 Insert e x v ->
166 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
168 Modify e fs ->
169 P.braces $ P.hang (pretty e <+> P.text "|")
170 4
171 (commaSep $ map field fs)
172 where
173 field (k,v) = variable k <+> P.text "<-" <+> pretty v
175 Record fs ->
176 P.braces $ P.nest 2 (commaSep $ map field fs)
177 where
178 field (x,e) = variable x <+> P.equals <+> pretty e
180 Markdown _ _ _ -> P.text "[markdown| ... |]"
182 GLShader _ _ _ -> P.text "[glShader| ... |]"
184 PortIn name _ -> P.text $ "<port:" ++ name ++ ">"
186 PortOut _ _ signal -> pretty signal
188instance Pretty ParseDef where
189 pretty def =
190 case def of
191 TypeAnnotation name tipe ->
192 variable name <+> P.colon <+> pretty tipe
193 Def pattern expr ->
194 pretty pattern <+> P.equals <+> pretty expr
196instance Pretty Def where
197 pretty (Definition pattern expr maybeTipe) =
198 P.vcat [ annotation, definition ]
199 where
200 definition = pretty pattern <+> P.equals <+> pretty expr
201 annotation = case maybeTipe of
202 Nothing -> P.empty
203 Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
205collectApps :: GeneralExpr ann def var -> [GeneralExpr ann def var]
206collectApps annExpr@(Annotation.A _ expr) =
207 case expr of
208 App a b -> collectApps a ++ [b]
209 _ -> [annExpr]
211collectLambdas :: GeneralExpr ann def var -> ([Pattern.Pattern], GeneralExpr 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)
220prettyParens :: (Pretty def, Pretty var) => GeneralExpr ann def var -> Doc
221prettyParens (Annotation.A _ expr) = parensIf needed (pretty expr)
222 where
223 needed =
224 case expr of
225 Binop _ _ _ -> True
226 Lambda _ _ -> True
227 App _ _ -> True
228 MultiIf _ -> True
229 Let _ _ -> True
230 Case _ _ -> True
231 Data name (_:_) -> name /= "::"
232 _ -> False