@@ -1,229 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
3−{-| The Abstract Syntax Tree (AST) for expressions comes in a couple formats.
4−The first is the fully general version and is labeled with a prime (Expr').
5−The others are specialized versions of the AST that represent specific phases
6−of the compilation process. I expect there to be more phases as we begin to
7−enrich the AST with more information.
9−module SourceSyntax.Expression where
11−import SourceSyntax.PrettyPrint
12−import Text.PrettyPrint as P
13−import qualified SourceSyntax.Helpers as Help
14−import qualified SourceSyntax.Annotation as Annotation
15−import qualified SourceSyntax.Pattern as Pattern
16−import qualified SourceSyntax.Type as SrcType
17−import qualified SourceSyntax.Literal as Literal
18−import qualified SourceSyntax.Variable as Variable
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
24−move 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
33− var: Representation of variables. Starts as strings, but is later enriched
34− with information about what module a variable came from.
37−type GeneralExpr annotation definition variable =
38− Annotation.Annotated annotation (GeneralExpr' annotation definition variable)
40−data GeneralExpr' ann def var
41− = Literal Literal.Literal
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)
64−---- SPECIALIZED ASTs ----
66−{-| Expressions created by the parser. These use a split representation of type
67−annotations and definitions, which is how they appear in source code and how
70−type ParseExpr = GeneralExpr Annotation.Region ParseDef Variable.Raw
71−type ParseExpr' = GeneralExpr' Annotation.Region ParseDef Variable.Raw
74− = Def Pattern.Pattern ParseExpr
75− | TypeAnnotation String SrcType.Type
78−{-| "Normal" expressions. When the compiler checks that type annotations and
79−ports are all paired with definitions in the appropriate order, it collapses
80−them into a Def that is easier to work with in later phases of compilation.
82−type Expr = GeneralExpr Annotation.Region Def Variable.Raw
83−type Expr' = GeneralExpr' Annotation.Region Def Variable.Raw
85−data Def = Definition Pattern.Pattern Expr (Maybe SrcType.Type)
92−rawVar :: String -> GeneralExpr' ann def Variable.Raw
93−rawVar x = Var (Variable.Raw x)
95−tuple :: [GeneralExpr ann def var] -> GeneralExpr' ann def var
96−tuple es = Data ("_Tuple" ++ show (length es)) es
98−delist :: GeneralExpr ann def var -> [GeneralExpr ann def var]
99−delist (Annotation.A _ (Data "::" [h,t])) = h : delist t
102−saveEnvName :: String
103−saveEnvName = "_save_the_environment!!!"
105−dummyLet :: (Pretty def) => [def] -> GeneralExpr Annotation.Region def Variable.Raw
107− Annotation.none $ Let defs (Annotation.none $ rawVar saveEnvName)
109−instance (Pretty def, Pretty var) => Pretty (GeneralExpr' ann def var) where
112− Literal lit -> pretty lit
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 ]
125− op' = if Help.isOp op then op else "`" ++ op ++ "`"
127− Lambda p e -> P.text "\\" <> args <+> P.text "->" <+> pretty body
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)
134− func:args = map prettyParens (collectApps (Annotation.A undefined expr))
136− MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
138− iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
141− P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
142− , P.text "in" <+> pretty e ]
145− P.hang pexpr 2 (P.vcat (map pretty' pats))
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 "[]"
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 ]
165− P.braces (pretty e <+> P.text "|" <+> variable x <+> P.equals <+> pretty v)
168− P.braces $ P.hang (pretty e <+> P.text "|")
170− (commaSep $ map field fs)
172− field (k,v) = variable k <+> P.text "<-" <+> pretty v
175− P.braces $ P.nest 2 (commaSep $ map field fs)
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
185−instance Pretty ParseDef where
188− TypeAnnotation name tipe ->
189− variable name <+> P.colon <+> pretty tipe
191− pretty pattern <+> P.equals <+> pretty expr
193−instance Pretty Def where
194− pretty (Definition pattern expr maybeTipe) =
195− P.vcat [ annotation, definition ]
197− definition = pretty pattern <+> P.equals <+> pretty expr
198− annotation = case maybeTipe of
200− Just tipe -> pretty pattern <+> P.colon <+> pretty tipe
202−collectApps :: GeneralExpr ann def var -> [GeneralExpr ann def var]
203−collectApps annExpr@(Annotation.A _ expr) =
205− App a b -> collectApps a ++ [b]
208−collectLambdas :: GeneralExpr ann def var -> ([Pattern.Pattern], GeneralExpr ann def var)
209−collectLambdas lexpr@(Annotation.A _ expr) =
211− Lambda pattern body ->
212− let (ps, body') = collectLambdas body
213− in (pattern : ps, body')
217−prettyParens :: (Pretty def, Pretty var) => GeneralExpr ann def var -> Doc
218−prettyParens (Annotation.A _ expr) = parensIf needed (pretty expr)
228− Data name (_:_) -> name /= "::"