git.iko.soy/elk
on 339ad77 help sign in
elk/compiler/SourceSyntax/Expression.hs
101 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 = Location.Located Expr
14data Expr = Literal Literal.Literal
15 | Range LExpr LExpr
16 | Access LExpr String
17 | Remove LExpr String
18 | Insert LExpr String LExpr
19 | Modify LExpr [(String,LExpr)]
20 | Record [(String,[String],LExpr)]
21 | Binop String LExpr LExpr
22 | Lambda String LExpr
23 | App LExpr LExpr
24 | MultiIf [(LExpr,LExpr)]
25 | Let [Def] LExpr
26 | Var String
27 | Case LExpr [(Pattern.Pattern,LExpr)]
28 | Data String [LExpr]
29 | Markdown Pandoc.Pandoc
30 deriving (Eq, Data, Typeable)
32data Def = FnDef String [String] LExpr
33 | OpDef String String String LExpr
34 | TypeAnnotation String Type
35 deriving (Eq, Data, Typeable)
37cons h t = Location.merge h t (Data "Cons" [h,t])
38nil = Location.L (Just "[]") Location.NoSpan (Data "Nil" [])
39list = foldr cons nil
40tuple es = Data ("Tuple" ++ show (length es)) es
42delist (Location.L _ _ (Data "Cons" [h,t])) = h : delist t
43delist _ = []
46instance Show Expr 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 Data name es
73 | name == "Cons" -> ("["++) . (++"]") . intercalate "," . map show $
74 delist (Location.none $ Data "Cons" es)
75 | name == "Nil" -> "[]"
76 | otherwise -> name ++ " " ++ intercalate " " (map show' es)
77 Markdown _ -> "[markdown| ... |]"
80instance Show Def where
81 show e =
82 case e of
83 FnDef v [] e -> v ++ " = " ++ show e
84 FnDef f args e -> f ++ concatMap (' ':) args ++ " = " ++ show e
85 OpDef op a1 a2 e -> intercalate " " [a1,op,a2] ++ " = " ++ show e
86 TypeAnnotation n t -> n ++ " : " ++ show t
88getLambdas (Location.L _ _ (Lambda x e)) = (x:xs,e')
89 where (xs,e') = getLambdas e
90getLambdas e = ([],e)
92needsParens e =
93 case e of
94 Binop _ _ _ -> True
95 Lambda _ _ -> True
96 App _ _ -> True
97 MultiIf _ -> True
98 Let _ _ -> True
99 Case _ _ -> True
100 Data name (x:xs) -> name /= "Cons"
101 _ -> False