git.iko.soy/elk
on 316cd1d help sign in
elk/compiler/SourceSyntax/Expression.hs
103 lines 4.0 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 | Data String [LExpr t v]
30 | Markdown Pandoc.Pandoc
31 deriving (Eq, Data, Typeable)
33data Def tipe var
34 = FnDef String [String] (LExpr tipe var)
35 | OpDef String String String (LExpr tipe var)
36 | TypeAnnotation String Type
37 deriving (Eq, Data, Typeable)
39cons h t = Location.merge h t (Data "Cons" [h,t])
40nil = Location.L (Just "[]") Location.NoSpan (Data "Nil" [])
41list = foldr cons nil
42tuple es = Data ("Tuple" ++ show (length es)) es
44delist (Location.L _ _ (Data "Cons" [h,t])) = h : delist t
45delist _ = []
48instance Show (Expr t v) where
49 show e =
50 let show' (Location.L _ _ e) = Help.parensIf (needsParens e) (show e) in
51 case e of
52 Literal lit -> show lit
53 Range e1 e2 -> "[" ++ show e1 ++ ".." ++ show e2 ++ "]"
54 Access e x -> show' e ++ "." ++ x
55 Remove e x -> Help.brkt (show e ++ " - " ++ x)
56 Insert (Location.L _ _ (Remove e y)) x v ->
57 Help.brkt (show e ++ " - " ++ y ++ " | " ++ x ++ " = " ++ show v)
58 Insert e x v -> Help.brkt (show e ++ " | " ++ x ++ " = " ++ show v)
59 Modify e fs -> Help.brkt (show e ++" | "++ intercalate ", " (map field fs))
60 where field (x,e) = x ++ " <- " ++ show e
61 Record r -> Help.brkt (intercalate ", " (map fields r))
62 where fields (f,args,e) = f ++ concatMap (' ':) args ++ " = " ++ show e
63 Binop op e1 e2 -> show' e1 ++ " " ++ op ++ " " ++ show' e2
64 Lambda x e -> let (xs,e') = getLambdas (Location.none $ Lambda x e) in
65 concat [ "\\", intercalate " " xs, " -> ", show e' ]
66 App e1 e2 -> show' e1 ++ " " ++ show' e2
67 MultiIf (p:ps) -> concat [ "if | ", iff p, sep (map iff ps) ]
68 where iff (b,e) = show b ++ " -> " ++ show e
69 sep = concatMap ("\n | " ++)
70 Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e
71 Var (c:cs) -> if Help.isOp c then Help.parens (c:cs) else c:cs
72 Case e pats -> "case "++ show e ++" of " ++ Help.brkt (intercalate " ; " pats')
73 where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats
74 Data name es
75 | name == "Cons" -> ("["++) . (++"]") . intercalate "," . map show $
76 delist (Location.none $ Data "Cons" es)
77 | name == "Nil" -> "[]"
78 | otherwise -> name ++ " " ++ intercalate " " (map show' es)
79 Markdown _ -> "[markdown| ... |]"
82instance Show (Def t v) where
83 show e =
84 case e of
85 FnDef v [] e -> v ++ " = " ++ show e
86 FnDef f args e -> f ++ concatMap (' ':) args ++ " = " ++ show e
87 OpDef op a1 a2 e -> intercalate " " [a1,op,a2] ++ " = " ++ show e
88 TypeAnnotation n t -> n ++ " : " ++ show t
90getLambdas (Location.L _ _ (Lambda x e)) = (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 /= "Cons"
103 _ -> False