git.iko.soy/elk
on 351c33c help sign in
elk/compiler/SourceSyntax/Expression.hs
103 lines 3.9 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, [String], LExpr t v)] -- [Def t v]
31 | Markdown Pandoc.Pandoc
32 deriving (Eq, Data, Typeable)
34data Def tipe var
35 = Def String [String] (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,args,e) = f ++ concatMap (' ':) args ++ " = " ++ 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 name@(c:_) args e ->
83 value ++ " = " ++ show e
84 where
85 value = if not (Help.isOp c) then name ++ concatMap (' ':) args else
86 case args of
87 [] -> parens name
88 [a,b] -> a ++ " " ++ name ++ " " ++ b
90getLambdas (Location.L _ _ (Lambda x e)) = (show x:xs,e')
91 where (xs,e') = getLambdas e
92getLambdas e = ([],e)
94needsParens e =
95 case e of
96 Binop _ _ _ -> True
97 Lambda _ _ -> True
98 App _ _ -> True
99 MultiIf _ -> True
100 Let _ _ -> True
101 Case _ _ -> True
102 Data name (x:xs) -> name /= "::"
103 _ -> False