git.iko.soy/elk
on cf016ea help sign in
elk/compiler/SourceSyntax/Expression.hs
133 lines 4.7 kB history raw
1module SourceSyntax.Expression where
3import Data.List (intercalate)
4import SourceSyntax.PrettyPrint
5import Text.PrettyPrint as P
6import qualified SourceSyntax.Helpers as Help
7import qualified SourceSyntax.Location as Location
8import qualified SourceSyntax.Pattern as Pattern
9import qualified SourceSyntax.Type as Type
10import qualified SourceSyntax.Literal as Literal
12type LExpr tipe var = Location.Located (Expr tipe var)
13data Expr t v
14 = Literal Literal.Literal
15 | Var String
16 | Range (LExpr t v) (LExpr t v)
17 | ExplicitList [LExpr t v]
18 | Binop String (LExpr t v) (LExpr t v)
19 | Lambda Pattern.Pattern (LExpr t v)
20 | App (LExpr t v) (LExpr t v)
21 | MultiIf [(LExpr t v,LExpr t v)]
22 | Let [Def t v] (LExpr t v)
23 | Case (LExpr t v) [(Pattern.Pattern, LExpr t v)]
24 | Data String [LExpr t v]
25 | Access (LExpr t v) String
26 | Remove (LExpr t v) String
27 | Insert (LExpr t v) String (LExpr t v)
28 | Modify (LExpr t v) [(String, LExpr t v)]
29 | Record [(String, LExpr t v)]
30 | Markdown String String [LExpr t v]
31 | GLShader String String
32 deriving (Eq)
34data Def tipe var
35 = Def Pattern.Pattern (LExpr tipe var)
36 | TypeAnnotation String Type.Type
37 deriving (Eq, Show)
39tuple es = Data ("_Tuple" ++ show (length es)) es
41delist (Location.L _ (Data "::" [h,t])) = h : delist t
42delist _ = []
44saveEnvName = "_save_the_environment!!!"
46dummyLet defs =
47 Location.none $ Let defs (Location.none $ Var saveEnvName)
49instance Show (Expr t v) where
50 show = render . pretty
52instance Pretty (Expr t v) where
53 pretty expr =
54 case expr of
55 Literal lit -> pretty lit
56 Var x -> variable x
57 Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)
58 ExplicitList es -> P.brackets (commaCat (map pretty es))
59 Binop "-" (Location.L _ (Literal (Literal.IntNum 0))) e ->
60 P.text "-" <> prettyParens e
61 Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op', prettyParens e2 ]
62 where op' = if Help.isOp op then op else "`" ++ op ++ "`"
63 Lambda p e -> let (ps,body) = collectLambdas (Location.none $ Lambda p e)
64 in P.text "\\" <> P.sep ps <+> P.text "->" <+> pretty body
65 App _ _ -> P.hang func 2 (P.sep args)
66 where func:args = map prettyParens (collectApps (Location.none expr))
67 MultiIf branches -> P.text "if" $$ nest 3 (vcat $ map iff branches)
68 where
69 iff (b,e) = P.text "|" <+> P.hang (pretty b <+> P.text "->") 2 (pretty e)
70 Let defs e ->
71 P.sep [ P.hang (P.text "let") 4 (P.vcat (map pretty defs))
72 , P.text "in" <+> pretty e ]
73 Case e pats ->
74 P.hang pexpr 2 (P.vcat (map pretty' pats))
75 where
76 pexpr = P.sep [ P.text "case" <+> pretty e, P.text "of" ]
77 pretty' (p,e) = pretty p <+> P.text "->" <+> pretty e
78 Data "::" [hd,tl] -> pretty hd <+> P.text "::" <+> pretty tl
79 Data "[]" [] -> P.text "[]"
80 Data name es -> P.hang (P.text name) 2 (P.sep (map prettyParens es))
81 Access e x -> prettyParens e <> P.text "." <> variable x
82 Remove e x -> P.braces (pretty e <+> P.text "-" <+> variable x)
83 Insert (Location.L _ (Remove e y)) x v ->
84 P.braces (pretty e <+> P.text "-" <+> variable y <+> P.text "|" <+> variable x <+> P.text "=" <+> pretty v)
85 Insert e x v ->
86 P.braces (pretty e <+> P.text "|" <+> variable x <+> P.text "=" <+> pretty v)
88 Modify e fs ->
89 P.braces $ P.hang (pretty e <+> P.text "|")
90 4
91 (commaSep $ map field fs)
92 where
93 field (x,e) = variable x <+> P.text "<-" <+> pretty e
95 Record fs ->
96 P.braces $ P.nest 2 (commaSep $ map field fs)
97 where
98 field (x,e) = variable x <+> P.text "=" <+> pretty e
100 Markdown _ _ _ -> P.text "[markdown| ... |]"
102instance Pretty (Def t v) where
103 pretty def =
104 case def of
105 TypeAnnotation name tipe ->
106 variable name <+> P.text ":" <+> pretty tipe
107 Def pattern expr ->
108 pretty pattern <+> P.text "=" <+> pretty expr
110collectApps lexpr@(Location.L _ expr) =
111 case expr of
112 App a b -> collectApps a ++ [b]
113 _ -> [lexpr]
115collectLambdas lexpr@(Location.L _ expr) =
116 case expr of
117 Lambda pattern body ->
118 let (ps, body') = collectLambdas body
119 in (pretty pattern : ps, body')
120 _ -> ([], lexpr)
122prettyParens (Location.L _ expr) = parensIf needed (pretty expr)
123 where
124 needed =
125 case expr of
126 Binop _ _ _ -> True
127 Lambda _ _ -> True
128 App _ _ -> True
129 MultiIf _ -> True
130 Let _ _ -> True
131 Case _ _ -> True
132 Data name (x:xs) -> name /= "::"
133 _ -> False