git.iko.soy/elk
on b412396 help sign in
elk/compiler/SourceSyntax/Expression.hs
229 lines 8.3 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 deriving (Show)
64---- SPECIALIZED ASTs ----
66{-| Expressions created by the parser. These use a split representation of type
67annotations and definitions, which is how they appear in source code and how
68they are parsed.
69-}
70type ParseExpr = GeneralExpr Annotation.Region ParseDef Variable.Raw
71type ParseExpr' = GeneralExpr' Annotation.Region ParseDef Variable.Raw
73data ParseDef
74 = Def Pattern.Pattern ParseExpr
75 | TypeAnnotation String SrcType.Type
76 deriving (Show)
78{-| "Normal" expressions. When the compiler checks that type annotations and
79ports are all paired with definitions in the appropriate order, it collapses
80them into a Def that is easier to work with in later phases of compilation.
81-}
82type Expr = GeneralExpr Annotation.Region Def Variable.Raw
83type Expr' = GeneralExpr' Annotation.Region Def Variable.Raw
85data Def = Definition Pattern.Pattern Expr (Maybe SrcType.Type)
86 deriving (Show)
90---- UTILITIES ----
92rawVar :: String -> GeneralExpr' ann def Variable.Raw
93rawVar x = Var (Variable.Raw x)
95tuple :: [GeneralExpr ann def var] -> GeneralExpr' ann def var
96tuple es = Data ("_Tuple" ++ show (length es)) es
98delist :: GeneralExpr ann def var -> [GeneralExpr ann def var]
99delist (Annotation.A _ (Data "::" [h,t])) = h : delist t
100delist _ = []
102saveEnvName :: String
103saveEnvName = "_save_the_environment!!!"
105dummyLet :: (Pretty def) => [def] -> GeneralExpr Annotation.Region def Variable.Raw
106dummyLet defs =
107 Annotation.none $ Let defs (Annotation.none $ rawVar saveEnvName)
109instance (Pretty def, Pretty var) => Pretty (GeneralExpr' ann def var) where
110 pretty expr =
111 case expr of
112 Literal lit -> pretty lit
114 Var x -> pretty x
116 Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)
118 ExplicitList es -> P.brackets (commaCat (map pretty es))
120 Binop "-" (Annotation.A _ (Literal (Literal.IntNum 0))) e ->
121 P.text "-" <> prettyParens e
123 Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op', prettyParens e2 ]
124 where
125 op' = if Help.isOp op then op else "`" ++ op ++ "`"
127 Lambda p e -> P.text "\\" <> args <+> P.text "->" <+> pretty body
128 where
129 (ps,body) = collectLambdas (Annotation.A undefined $ Lambda p e)
130 args = P.sep (map Pattern.prettyParens ps)
132 App _ _ -> P.hang func 2 (P.sep args)
133 where
134 func:args = map prettyParens (collectApps (Annotation.A undefined expr))
136 MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
137 where
138 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
140 Let defs e ->
141 P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
142 , P.text "in" <+> pretty e ]
144 Case e pats ->
145 P.hang pexpr 2 (P.vcat (map pretty' pats))
146 where
147 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
148 pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
150 Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
151 Data "[]" [] -> P.text "[]"
152 Data name es
153 | Help.isTuple name -> P.parens (commaCat (map pretty es))
154 | otherwise -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
156 Access e x -> prettyParens e <> P.text "." <> variable x
158 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
160 Insert (Annotation.A _ (Remove e y)) x v ->
161 P.braces $ P.hsep [ pretty e, P.text "-", variable y, P.text "|"
162 , variable x, P.equals, pretty v ]
164 Insert e x v ->
165 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
167 Modify e fs ->
168 P.braces $ P.hang (pretty e <+> P.text "|")
169 4
170 (commaSep $ map field fs)
171 where
172 field (k,v) = variable k <+> P.text "<-" <+> pretty v
174 Record fs ->
175 P.braces $ P.nest 2 (commaSep $ map field fs)
176 where
177 field (x,e) = variable x <+> P.equals <+> pretty e
179 Markdown _ _ _ -> P.text "[markdown| ... |]"
181 PortIn name _ -> P.text $ "<port:" ++ name ++ ">"
183 PortOut _ _ signal -> pretty signal
185instance Pretty ParseDef where
186 pretty def =
187 case def of
188 TypeAnnotation name tipe ->
189 variable name <+> P.colon <+> pretty tipe
190 Def pattern expr ->
191 pretty pattern <+> P.equals <+> pretty expr
193instance Pretty Def where
194 pretty (Definition pattern expr maybeTipe) =
195 P.vcat [ annotation, definition ]
196 where
197 definition = pretty pattern <+> P.equals <+> pretty expr
198 annotation = case maybeTipe of
199 Nothing -> P.empty
200 Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
202collectApps :: GeneralExpr ann def var -> [GeneralExpr ann def var]
203collectApps annExpr@(Annotation.A _ expr) =
204 case expr of
205 App a b -> collectApps a ++ [b]
206 _ -> [annExpr]
208collectLambdas :: GeneralExpr ann def var -> ([Pattern.Pattern], GeneralExpr ann def var)
209collectLambdas lexpr@(Annotation.A _ expr) =
210 case expr of
211 Lambda pattern body ->
212 let (ps, body') = collectLambdas body
213 in (pattern : ps, body')
215 _ -> ([], lexpr)
217prettyParens :: (Pretty def, Pretty var) => GeneralExpr ann def var -> Doc
218prettyParens (Annotation.A _ expr) = parensIf needed (pretty expr)
219 where
220 needed =
221 case expr of
222 Binop _ _ _ -> True
223 Lambda _ _ -> True
224 App _ _ -> True
225 MultiIf _ -> True
226 Let _ _ -> True
227 Case _ _ -> True
228 Data name (_:_) -> name /= "::"
229 _ -> False