git.iko.soy/elk
on 73cff94 help sign in
elk/compiler/SourceSyntax/Expression.hs
203 lines 7.4 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 -> P.text "\\" <> args <+> P.text "->" <+> pretty body
115 where
116 (ps,body) = collectLambdas (Location.none $ Lambda p e)
117 args = P.sep (map Pattern.prettyParens ps)
118 App _ _ -> P.hang func 2 (P.sep args)
119 where func:args = map prettyParens (collectApps (Location.none expr))
120 MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
121 where
122 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
123 Let defs e ->
124 P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
125 , P.text "in" <+> pretty e ]
126 Case e pats ->
127 P.hang pexpr 2 (P.vcat (map pretty' pats))
128 where
129 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
130 pretty' (p,b) = pretty p <+> P.text "->" <+> pretty b
131 Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
132 Data "[]" [] -> P.text "[]"
133 Data name es
134 | Help.isTuple name -> P.parens (commaCat (map pretty es))
135 | otherwise -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
136 Access e x -> prettyParens e <> P.text "." <> variable x
137 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
138 Insert (Location.L _ (Remove e y)) x v ->
139 P.braces (pretty e <+> P.text "-" <+> variable y <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
140 Insert e x v ->
141 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
143 Modify e fs ->
144 P.braces $ P.hang (pretty e <+> P.text "|")
145 4
146 (commaSep $ map field fs)
147 where
148 field (k,v) = variable k <+> P.text "<-" <+> pretty v
150 Record fs ->
151 P.braces $ P.nest 2 (commaSep $ map field fs)
152 where
153 field (x,e) = variable x <+> P.equals <+> pretty e
155 Markdown _ _ _ -> P.text "[markdown| ... |]"
157 PortIn name _ -> P.text $ "<port:" ++ name ++ ">"
159 PortOut _ _ signal -> pretty signal
161instance Pretty ParseDef where
162 pretty def =
163 case def of
164 TypeAnnotation name tipe ->
165 variable name <+> P.colon <+> pretty tipe
166 Def pattern expr ->
167 pretty pattern <+> P.equals <+> pretty expr
169instance Pretty Def where
170 pretty (Definition pattern expr maybeTipe) =
171 P.vcat [ annotation, definition ]
172 where
173 definition = pretty pattern <+> P.equals <+> pretty expr
174 annotation = case maybeTipe of
175 Nothing -> P.empty
176 Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
178collectApps :: LExpr' def -> [LExpr' def]
179collectApps lexpr@(Location.L _ expr) =
180 case expr of
181 App a b -> collectApps a ++ [b]
182 _ -> [lexpr]
184collectLambdas :: LExpr' def -> ([Pattern.Pattern], LExpr' def)
185collectLambdas lexpr@(Location.L _ expr) =
186 case expr of
187 Lambda pattern body -> (pattern : ps, body')
188 where (ps, body') = collectLambdas body
189 _ -> ([], lexpr)
191prettyParens :: (Pretty def) => LExpr' def -> Doc
192prettyParens (Location.L _ expr) = parensIf needed (pretty expr)
193 where
194 needed =
195 case expr of
196 Binop _ _ _ -> True
197 Lambda _ _ -> True
198 App _ _ -> True
199 MultiIf _ -> True
200 Let _ _ -> True
201 Case _ _ -> True
202 Data name (_:_) -> name /= "::"
203 _ -> False