git.iko.soy/elk
on 69ed763 help sign in
elk/compiler/SourceSyntax/Expression.hs
98 lines 3.6 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2module SourceSyntax.Expression where
4import Data.Data
5import Data.List (intercalate)
6import qualified Text.Pandoc as Pandoc
7import qualified SourceSyntax.Helpers as Help
8import qualified SourceSyntax.Location as Location
9import qualified SourceSyntax.Pattern as Pattern
10import qualified SourceSyntax.Literal as Literal
11import Types.Types
13type LExpr tipe var = Location.Located (Expr tipe var)
14data Expr t v
15 = Literal Literal.Literal
16 | Var String
17 | Range (LExpr t v) (LExpr t v)
18 | ExplicitList [LExpr t v]
19 | Binop String (LExpr t v) (LExpr t v)
20 | Lambda Pattern.Pattern (LExpr t v)
21 | App (LExpr t v) (LExpr t v)
22 | MultiIf [(LExpr t v,LExpr t v)]
23 | Let [Def t v] (LExpr t v)
24 | Case (LExpr t v) [(Pattern.Pattern, LExpr t v)]
25 | Data String [LExpr t v]
26 | Access (LExpr t v) String
27 | Remove (LExpr t v) String
28 | Insert (LExpr t v) String (LExpr t v)
29 | Modify (LExpr t v) [(String, LExpr t v)]
30 | Record [(String, LExpr t v)]
31 | Markdown Pandoc.Pandoc
32 deriving (Eq, Data, Typeable)
34data Def tipe var
35 = Def Pattern.Pattern (LExpr tipe var)
36 | TypeAnnotation String Type
37 deriving (Eq, Data, Typeable)
39tuple es = Data ("Tuple" ++ show (length es)) es
41delist (Location.L _ _ (Data "::" [h,t])) = h : delist t
42delist _ = []
45instance Show (Expr t v) where
46 show e =
47 let show' (Location.L _ _ e) = Help.parensIf (needsParens e) (show e) in
48 case e of
49 Literal lit -> show lit
50 Range e1 e2 -> "[" ++ show e1 ++ ".." ++ show e2 ++ "]"
51 ExplicitList es -> "[" ++ intercalate "," (map show es) ++ "]"
52 Binop op e1 e2 -> show' e1 ++ " " ++ op ++ " " ++ show' e2
53 Lambda x e -> let (xs,e') = getLambdas (Location.none $ Lambda x e) in
54 concat [ "\\", intercalate " " xs, " -> ", show e' ]
55 App e1 e2 -> show' e1 ++ " " ++ show' e2
56 MultiIf (p:ps) -> concat [ "if | ", iff p, sep (map iff ps) ]
57 where iff (b,e) = show b ++ " -> " ++ show e
58 sep = concatMap ("\n | " ++)
59 Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e
60 Var (c:cs) -> if Help.isOp c then Help.parens (c:cs) else c:cs
61 Case e pats -> "case "++ show e ++" of " ++ Help.brkt (intercalate " ; " pats')
62 where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats
63 Data "::" [h,t] -> show h ++ " :: " ++ show t
64 Data "[]" [] -> "[]"
65 Data name es -> name ++ " " ++ intercalate " " (map show' es)
66 Access e x -> show' e ++ "." ++ x
67 Remove e x -> Help.brkt (show e ++ " - " ++ x)
68 Insert (Location.L _ _ (Remove e y)) x v ->
69 Help.brkt (show e ++ " - " ++ y ++ " | " ++ x ++ " = " ++ show v)
70 Insert e x v -> Help.brkt (show e ++ " | " ++ x ++ " = " ++ show v)
71 Modify e fs -> Help.brkt (show e ++" | "++ intercalate ", " (map field fs))
72 where field (x,e) = x ++ " <- " ++ show e
73 Record r -> Help.brkt (intercalate ", " (map fields r))
74 where fields (f,e) = f ++ " = " ++ show e
75 Markdown _ -> "[markdown| ... |]"
78instance Show (Def t v) where
79 show e =
80 case e of
81 TypeAnnotation n t -> n ++ " : " ++ show t
82 Def pattern e ->
83 show pattern ++ " = " ++ show e
85getLambdas (Location.L _ _ (Lambda x e)) = (show x:xs,e')
86 where (xs,e') = getLambdas e
87getLambdas e = ([],e)
89needsParens e =
90 case e of
91 Binop _ _ _ -> True
92 Lambda _ _ -> True
93 App _ _ -> True
94 MultiIf _ -> True
95 Let _ _ -> True
96 Case _ _ -> True
97 Data name (x:xs) -> name /= "::"
98 _ -> False