git.iko.soy/elk
on f530040 help sign in
elk/compiler/SourceSyntax/Expression.hs
206 lines 7.5 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.Location as Location
15import qualified SourceSyntax.Pattern as Pattern
16import qualified SourceSyntax.Type as SrcType
17import qualified SourceSyntax.Literal as Literal
19---- GENERAL AST ----
21{-| This is a located expression, meaning it is tagged with info about where it
22came from in the source code. Expr' is defined in terms of LExpr' so that the
23location information does not need to be an extra field on every constructor.
24-}
25type LExpr' def = Location.Located (Expr' def)
27{-| This is a fully general Abstract Syntax Tree (AST) for expressions. It has
28"type holes" that allow us to enrich the AST with additional information as we
29move through the compilation process. The type holes let us show these
30structural changes in the types. The only type hole right now is:
32 def: Parsing allows two kinds of definitions (type annotations or definitions),
33 but later checks will see that they are well formed and combine them.
35-}
36data Expr' def
37 = Literal Literal.Literal
38 | Var String
39 | Range (LExpr' def) (LExpr' def)
40 | ExplicitList [LExpr' def]
41 | Binop String (LExpr' def) (LExpr' def)
42 | Lambda Pattern.Pattern (LExpr' def)
43 | App (LExpr' def) (LExpr' def)
44 | MultiIf [(LExpr' def,LExpr' def)]
45 | Let [def] (LExpr' def)
46 | Case (LExpr' def) [(Pattern.Pattern, LExpr' def)]
47 | Data String [LExpr' def]
48 | Access (LExpr' def) String
49 | Remove (LExpr' def) String
50 | Insert (LExpr' def) String (LExpr' def)
51 | Modify (LExpr' def) [(String, LExpr' def)]
52 | Record [(String, LExpr' def)]
53 | Markdown String String [LExpr' def]
54 -- for type checking and code gen only
55 | PortIn String SrcType.Type
56 | PortOut String SrcType.Type (LExpr' def)
57 | GLShader String String Literal.GLShaderTipe
60---- SPECIALIZED ASTs ----
62{-| Expressions created by the parser. These use a split representation of type
63annotations and definitions, which is how they appear in source code and how
64they are parsed.
65-}
66type ParseExpr = Expr' ParseDef
67type LParseExpr = LExpr' ParseDef
69data ParseDef
70 = Def Pattern.Pattern LParseExpr
71 | TypeAnnotation String SrcType.Type
72 deriving (Show)
74{-| "Normal" expressions. When the compiler checks that type annotations and
75ports are all paired with definitions in the appropriate order, it collapses
76them into a Def that is easier to work with in later phases of compilation.
77-}
78type LExpr = LExpr' Def
79type Expr = Expr' Def
81data Def = Definition Pattern.Pattern LExpr (Maybe SrcType.Type)
82 deriving (Show)
85---- UTILITIES ----
87tuple :: [LExpr' def] -> Expr' def
88tuple es = Data ("_Tuple" ++ show (length es)) es
90delist :: LExpr' def -> [LExpr' def]
91delist (Location.L _ (Data "::" [h,t])) = h : delist t
92delist _ = []
94saveEnvName :: String
95saveEnvName = "_save_the_environment!!!"
97dummyLet :: Pretty def => [def] -> LExpr' def
98dummyLet defs =
99 Location.none $ Let defs (Location.none $ Var saveEnvName)
101instance Pretty def => Show (Expr' def) where
102 show = render . pretty
104instance Pretty def => Pretty (Expr' def) where
105 pretty expr =
106 case expr of
107 Literal lit -> pretty lit
108 Var x -> variable x
109 Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)
110 ExplicitList es -> P.brackets (commaCat (map pretty es))
111 Binop "-" (Location.L _ (Literal (Literal.IntNum 0))) e ->
112 P.text "-" <> prettyParens e
113 Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op', prettyParens e2 ]
114 where op' = if Help.isOp op then op else "`" ++ op ++ "`"
115 Lambda p e -> P.text "\\" <> args <+> P.text "->" <+> pretty body
116 where
117 (ps,body) = collectLambdas (Location.none $ Lambda p e)
118 args = P.sep (map Pattern.prettyParens ps)
119 App _ _ -> P.hang func 2 (P.sep args)
120 where func:args = map prettyParens (collectApps (Location.none expr))
121 MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
122 where
123 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
124 Let defs e ->
125 P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
126 , P.text "in" <+> pretty e ]
127 Case e pats ->
128 P.hang pexpr 2 (P.vcat (map pretty' pats))
129 where
130 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
131 pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
132 Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
133 Data "[]" [] -> P.text "[]"
134 Data name es
135 | Help.isTuple name -> P.parens (commaCat (map pretty es))
136 | otherwise -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
137 Access e x -> prettyParens e <> P.text "." <> variable x
138 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
139 Insert (Location.L _ (Remove e y)) x v ->
140 P.braces (pretty e <+> P.text "-" <+> variable y <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
141 Insert e x v ->
142 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
144 Modify e fs ->
145 P.braces $ P.hang (pretty e <+> P.text "|")
146 4
147 (commaSep $ map field fs)
148 where
149 field (k,v) = variable k <+> P.text "<-" <+> pretty v
151 Record fs ->
152 P.braces $ P.nest 2 (commaSep $ map field fs)
153 where
154 field (x,e) = variable x <+> P.equals <+> pretty e
156 Markdown _ _ _ -> P.text "[markdown| ... |]"
158 GLShader _ _ _ -> P.text "[glShader| ... |]"
160 PortIn name _ -> P.text $ "<port:" ++ name ++ ">"
162 PortOut _ _ signal -> pretty signal
164instance Pretty ParseDef where
165 pretty def =
166 case def of
167 TypeAnnotation name tipe ->
168 variable name <+> P.colon <+> pretty tipe
169 Def pattern expr ->
170 pretty pattern <+> P.equals <+> pretty expr
172instance Pretty Def where
173 pretty (Definition pattern expr maybeTipe) =
174 P.vcat [ annotation, definition ]
175 where
176 definition = pretty pattern <+> P.equals <+> pretty expr
177 annotation = case maybeTipe of
178 Nothing -> P.empty
179 Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
181collectApps :: LExpr' def -> [LExpr' def]
182collectApps lexpr@(Location.L _ expr) =
183 case expr of
184 App a b -> collectApps a ++ [b]
185 _ -> [lexpr]
187collectLambdas :: LExpr' def -> ([Pattern.Pattern], LExpr' def)
188collectLambdas lexpr@(Location.L _ expr) =
189 case expr of
190 Lambda pattern body -> (pattern : ps, body')
191 where (ps, body') = collectLambdas body
192 _ -> ([], lexpr)
194prettyParens :: (Pretty def) => LExpr' def -> Doc
195prettyParens (Location.L _ expr) = parensIf needed (pretty expr)
196 where
197 needed =
198 case expr of
199 Binop _ _ _ -> True
200 Lambda _ _ -> True
201 App _ _ -> True
202 MultiIf _ -> True
203 Let _ _ -> True
204 Case _ _ -> True
205 Data name (_:_) -> name /= "::"
206 _ -> False