git.iko.soy/elk
on a2e9bef help sign in
elk/compiler/SourceSyntax/Expression.hs
100 lines 3.8 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 | Access (LExpr t v) String
19 | Remove (LExpr t v) String
20 | Insert (LExpr t v) String (LExpr t v)
21 | Modify (LExpr t v) [(String, LExpr t v)]
22 | Record [(String, [String], LExpr t v)]
23 | Binop String (LExpr t v) (LExpr t v)
24 | Lambda String (LExpr t v)
25 | App (LExpr t v) (LExpr t v)
26 | MultiIf [(LExpr t v,LExpr t v)]
27 | Let [Def t v] (LExpr t v)
28 | Case (LExpr t v) [(Pattern.Pattern, LExpr t v)]
29 | ExplicitList [LExpr t v]
30 | Data String [LExpr t v]
31 | Markdown Pandoc.Pandoc
32 deriving (Eq, Data, Typeable)
34data Def tipe var
35 = FnDef String [String] (LExpr tipe var)
36 | OpDef String String String (LExpr tipe var)
37 | TypeAnnotation String Type
38 deriving (Eq, Data, Typeable)
40tuple es = Data ("Tuple" ++ show (length es)) es
42delist (Location.L _ _ (Data "::" [h,t])) = h : delist t
43delist _ = []
46instance Show (Expr t v) where
47 show e =
48 let show' (Location.L _ _ e) = Help.parensIf (needsParens e) (show e) in
49 case e of
50 Literal lit -> show lit
51 Range e1 e2 -> "[" ++ show e1 ++ ".." ++ show e2 ++ "]"
52 Access e x -> show' e ++ "." ++ x
53 Remove e x -> Help.brkt (show e ++ " - " ++ x)
54 Insert (Location.L _ _ (Remove e y)) x v ->
55 Help.brkt (show e ++ " - " ++ y ++ " | " ++ x ++ " = " ++ show v)
56 Insert e x v -> Help.brkt (show e ++ " | " ++ x ++ " = " ++ show v)
57 Modify e fs -> Help.brkt (show e ++" | "++ intercalate ", " (map field fs))
58 where field (x,e) = x ++ " <- " ++ show e
59 Record r -> Help.brkt (intercalate ", " (map fields r))
60 where fields (f,args,e) = f ++ concatMap (' ':) args ++ " = " ++ show e
61 Binop op e1 e2 -> show' e1 ++ " " ++ op ++ " " ++ show' e2
62 Lambda x e -> let (xs,e') = getLambdas (Location.none $ Lambda x e) in
63 concat [ "\\", intercalate " " xs, " -> ", show e' ]
64 App e1 e2 -> show' e1 ++ " " ++ show' e2
65 MultiIf (p:ps) -> concat [ "if | ", iff p, sep (map iff ps) ]
66 where iff (b,e) = show b ++ " -> " ++ show e
67 sep = concatMap ("\n | " ++)
68 Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e
69 Var (c:cs) -> if Help.isOp c then Help.parens (c:cs) else c:cs
70 Case e pats -> "case "++ show e ++" of " ++ Help.brkt (intercalate " ; " pats')
71 where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats
72 ExplicitList es -> "[" ++ intercalate "," (map show es) ++ "]"
73 Data "::" [h,t] -> show h ++ " :: " ++ show t
74 Data "[]" [] -> "[]"
75 Data name es -> name ++ " " ++ intercalate " " (map show' es)
76 Markdown _ -> "[markdown| ... |]"
79instance Show (Def t v) where
80 show e =
81 case e of
82 FnDef v [] e -> v ++ " = " ++ show e
83 FnDef f args e -> f ++ concatMap (' ':) args ++ " = " ++ show e
84 OpDef op a1 a2 e -> intercalate " " [a1,op,a2] ++ " = " ++ show e
85 TypeAnnotation n t -> n ++ " : " ++ show t
87getLambdas (Location.L _ _ (Lambda x e)) = (x:xs,e')
88 where (xs,e') = getLambdas e
89getLambdas e = ([],e)
91needsParens e =
92 case e of
93 Binop _ _ _ -> True
94 Lambda _ _ -> True
95 App _ _ -> True
96 MultiIf _ -> True
97 Let _ _ -> True
98 Case _ _ -> True
99 Data name (x:xs) -> name /= "::"
100 _ -> False