git.iko.soy/elk
on 1191c8a help sign in
elk/compiler/SourceSyntax/Expression.hs
200 lines 7.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module SourceSyntax.Expression where
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-}
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)
59---- SPECIALIZED ASTs ----
61{-| Expressions created by the parser. These use a split representation of type
62annotations and definitions, which is how they appear in source code and how
63they are parsed.
64-}
65type ParseExpr = Expr' ParseDef
66type LParseExpr = LExpr' ParseDef
68data ParseDef
69 = Def Pattern.Pattern LParseExpr
70 | TypeAnnotation String SrcType.Type
71 deriving (Show)
73{-| "Normal" expressions. When the compiler checks that type annotations and
74ports are all paired with definitions in the appropriate order, it collapses
75them into a Def that is easier to work with in later phases of compilation.
76-}
77type LExpr = LExpr' Def
78type Expr = Expr' Def
80data Def = Definition Pattern.Pattern LExpr (Maybe SrcType.Type)
81 deriving (Show)
84---- UTILITIES ----
86tuple :: [LExpr' def] -> Expr' def
87tuple es = Data ("_Tuple" ++ show (length es)) es
89delist :: LExpr' def -> [LExpr' def]
90delist (Location.L _ (Data "::" [h,t])) = h : delist t
91delist _ = []
93saveEnvName :: String
94saveEnvName = "_save_the_environment!!!"
96dummyLet :: Pretty def => [def] -> LExpr' def
97dummyLet defs =
98 Location.none $ Let defs (Location.none $ Var saveEnvName)
100instance Pretty def => Show (Expr' def) where
101 show = render . pretty
103instance Pretty def => Pretty (Expr' def) where
104 pretty expr =
105 case expr of
106 Literal lit -> pretty lit
107 Var x -> variable x
108 Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)
109 ExplicitList es -> P.brackets (commaCat (map pretty es))
110 Binop "-" (Location.L _ (Literal (Literal.IntNum 0))) e ->
111 P.text "-" <> prettyParens e
112 Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op', prettyParens e2 ]
113 where op' = if Help.isOp op then op else "`" ++ op ++ "`"
114 Lambda p e -> let (ps,body) = collectLambdas (Location.none $ Lambda p e)
115 in P.text "\\" <> P.sep ps <+> P.text "->" <+> pretty body
116 App _ _ -> P.hang func 2 (P.sep args)
117 where func:args = map prettyParens (collectApps (Location.none expr))
118 MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
119 where
120 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
121 Let defs e ->
122 P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
123 , P.text "in" <+> pretty e ]
124 Case e pats ->
125 P.hang pexpr 2 (P.vcat (map pretty' pats))
126 where
127 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
128 pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
129 Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
130 Data "[]" [] -> P.text "[]"
131 Data name es -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
132 Access e x -> prettyParens e <> P.text "." <> variable x
133 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
134 Insert (Location.L _ (Remove e y)) x v ->
135 P.braces (pretty e <+> P.text "-" <+> variable y <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
136 Insert e x v ->
137 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
139 Modify e fs ->
140 P.braces $ P.hang (pretty e <+> P.text "|")
141 4
142 (commaSep $ map field fs)
143 where
144 field (k,v) = variable k <+> P.text "<-" <+> pretty v
146 Record fs ->
147 P.braces $ P.nest 2 (commaSep $ map field fs)
148 where
149 field (x,e) = variable x <+> P.equals <+> pretty e
151 Markdown _ _ _ -> P.text "[markdown| ... |]"
153 PortIn name _ -> P.text $ "<port:" ++ name ++ ">"
155 PortOut _ _ signal -> pretty signal
157instance Pretty ParseDef where
158 pretty def =
159 case def of
160 TypeAnnotation name tipe ->
161 variable name <+> P.colon <+> pretty tipe
162 Def pattern expr ->
163 pretty pattern <+> P.equals <+> pretty expr
165instance Pretty Def where
166 pretty (Definition pattern expr maybeTipe) =
167 P.vcat [ annotation, definition ]
168 where
169 definition = pretty pattern <+> P.equals <+> pretty expr
170 annotation = case maybeTipe of
171 Nothing -> P.empty
172 Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
174collectApps :: LExpr' def -> [LExpr' def]
175collectApps lexpr@(Location.L _ expr) =
176 case expr of
177 App a b -> collectApps a ++ [b]
178 _ -> [lexpr]
180collectLambdas :: LExpr' def -> ([Doc], LExpr' def)
181collectLambdas lexpr@(Location.L _ expr) =
182 case expr of
183 Lambda pattern body ->
184 let (ps, body') = collectLambdas body
185 in (pretty pattern : ps, body')
186 _ -> ([], lexpr)
188prettyParens :: (Pretty def) => LExpr' def -> Doc
189prettyParens (Location.L _ expr) = parensIf needed (pretty expr)
190 where
191 needed =
192 case expr of
193 Binop _ _ _ -> True
194 Lambda _ _ -> True
195 App _ _ -> True
196 MultiIf _ -> True
197 Let _ _ -> True
198 Case _ _ -> True
199 Data name (_:_) -> name /= "::"
200 _ -> False