@@ -0,0 +1,101 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+module SourceSyntax.Expression where
3+
4+import Data.Data
5+import Data.List (intercalate)
6+import qualified Text.Pandoc as Pandoc
7+import qualified SourceSyntax.Helpers as Help
8+import qualified SourceSyntax.Location as Location
9+import qualified SourceSyntax.Pattern as Pattern
10+import qualified SourceSyntax.Literal as Literal
11+import Types.Types
12+
13+type LExpr = Location.Located Expr
14+data 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)
31+
32+data Def = FnDef String [String] LExpr
33+ | OpDef String String String LExpr
34+ | TypeAnnotation String Type
35+ deriving (Eq, Data, Typeable)
36+
37+cons h t = Location.merge h t (Data "Cons" [h,t])
38+nil = Location.L (Just "[]") Location.NoSpan (Data "Nil" [])
39+list = foldr cons nil
40+tuple es = Data ("Tuple" ++ show (length es)) es
41+
42+delist (Location.L _ _ (Data "Cons" [h,t])) = h : delist t
43+delist _ = []
44+
45+
46+instance 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| ... |]"
78+
79+
80+instance 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
87+
88+getLambdas (Location.L _ _ (Lambda x e)) = (x:xs,e')
89+ where (xs,e') = getLambdas e
90+getLambdas e = ([],e)
91+
92+needsParens 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