@@ -1,156 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−module Ast where
3−
4−import Located
5−import Data.Char (isDigit, isSymbol)
6−import Data.List (intercalate)
7−import Types.Types
8−import qualified Text.Pandoc as Pandoc
9−import Data.Data
10−
11−data Module = Module [String] Exports Imports [Statement]
12− deriving (Show)
13−
14−type Exports = [String]
15−
16−type Imports = [(String, ImportMethod)]
17−data ImportMethod = As String | Importing [String] | Hiding [String]
18− deriving (Eq, Ord, Show, Data, Typeable)
19−
20−
21−data Pattern = PData String [Pattern]
22− | PRecord [String]
23− | PAsVar String Pattern
24− | PVar String
25− | PAnything
26− deriving (Eq, Data, Typeable)
27−
28−type CExpr = Located Expr
29−data Expr = IntNum Int
30− | FloatNum Float
31− | Chr Char
32− | Str String
33− | Boolean Bool
34− | Range CExpr CExpr
35− | Access CExpr String
36− | Remove CExpr String
37− | Insert CExpr String CExpr
38− | Modify CExpr [(String,CExpr)]
39− | Record [(String,[String],CExpr)]
40− | Binop String CExpr CExpr
41− | Lambda String CExpr
42− | App CExpr CExpr
43− | MultiIf [(CExpr,CExpr)]
44− | Let [Def] CExpr
45− | Var String
46− | Case CExpr [(Pattern,CExpr)]
47− | Data String [CExpr]
48− | Markdown Pandoc.Pandoc
49− deriving (Eq, Data, Typeable)
50−
51−data Def = FnDef String [String] CExpr
52− | OpDef String String String CExpr
53− | TypeAnnotation String Type
54− deriving (Eq, Data, Typeable)
55−
56−data Statement = Definition Def
57− | Datatype String [X] [(String,[Type])]
58− | TypeAlias String [X] Type
59− | ImportEvent String CExpr String Type
60− | ExportEvent String String Type
61− deriving (Eq, Show, Data, Typeable)
62−
63−cons h t = epos h t (Data "Cons" [h,t])
64−nil = L (Just "[]") NoSpan (Data "Nil" [])
65−list = foldr cons nil
66−tuple es = Data ("Tuple" ++ show (length es)) es
67−
68−delist (L _ _ (Data "Cons" [h,t])) = h : delist t
69−delist _ = []
70−
71−
72−pcons h t = PData "Cons" [h,t]
73−pnil = PData "Nil" []
74−plist = foldr pcons pnil
75−ptuple es = PData ("Tuple" ++ show (length es)) es
76−
77−brkt s = "{ " ++ s ++ " }"
78−parensIf b s = if b then parens s else s
79−isOp c = isSymbol c || elem c "+-/*=.$<>:&|^?%#@~!"
80−
81−instance Show Pattern where
82− show p =
83− case p of
84− PRecord fs -> brkt (intercalate ", " fs)
85− PVar x -> x
86− PAsVar x p -> show p ++ " as " ++ x
87− PAnything -> "_"
88− PData "Cons" [hd@(PData "Cons" _),tl] ->
89− parens (show hd) ++ " :: " ++ show tl
90− PData "Cons" [hd,tl] -> show hd ++ " : " ++ show tl
91− PData "Nil" [] -> "[]"
92− PData name ps ->
93− if take 5 name == "Tuple" && all isDigit (drop 5 name) then
94− parens . intercalate ", " $ map show ps
95− else parensIf (not (null ps)) $ unwords (name : map show ps)
96−
97−instance Show Expr where
98− show e =
99− let show' (L _ _ e) = parensIf (needsParens e) (show e) in
100− case e of
101− IntNum n -> show n
102− FloatNum n -> show n
103− Chr c -> show c
104− Str s -> show s
105− Boolean b -> show b
106− Range e1 e2 -> "[" ++ show e1 ++ ".." ++ show e2 ++ "]"
107− Access e x -> show' e ++ "." ++ x
108− Remove e x -> brkt (show e ++ " - " ++ x)
109− Insert (L _ _ (Remove e y)) x v ->
110− brkt (show e ++ " - " ++ y ++ " | " ++ x ++ " = " ++ show v)
111− Insert e x v -> brkt (show e ++ " | " ++ x ++ " = " ++ show v)
112− Modify e fs -> brkt (show e ++" | "++ intercalate ", " (map field fs))
113− where field (x,e) = x ++ " <- " ++ show e
114− Record r -> brkt (intercalate ", " (map fields r))
115− where fields (f,args,e) = f ++ concatMap (' ':) args ++ " = " ++ show e
116− Binop op e1 e2 -> show' e1 ++ " " ++ op ++ " " ++ show' e2
117− Lambda x e -> let (xs,e') = getLambdas (notLocated $ Lambda x e) in
118− concat [ "\\", intercalate " " xs, " -> ", show e' ]
119− App e1 e2 -> show' e1 ++ " " ++ show' e2
120− MultiIf (p:ps) -> concat [ "if | ", iff p, sep (map iff ps) ]
121− where iff (b,e) = show b ++ " -> " ++ show e
122− sep = concatMap ("\n | " ++)
123− Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e
124− Var (c:cs) -> if isOp c then parens (c:cs) else c:cs
125− Case e pats -> "case "++ show e ++" of " ++ brkt (intercalate " ; " pats')
126− where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats
127− Data name es
128− | name == "Cons" -> ("["++) . (++"]") . intercalate "," . map show $
129− delist (notLocated $ Data "Cons" es)
130− | name == "Nil" -> "[]"
131− | otherwise -> name ++ " " ++ intercalate " " (map show' es)
132− Markdown _ -> "[markdown| ... |]"
133−
134−
135−instance Show Def where
136− show e =
137− case e of
138− FnDef v [] e -> v ++ " = " ++ show e
139− FnDef f args e -> f ++ concatMap (' ':) args ++ " = " ++ show e
140− OpDef op a1 a2 e -> intercalate " " [a1,op,a2] ++ " = " ++ show e
141− TypeAnnotation n t -> n ++ " : " ++ show t
142−
143−getLambdas (L _ _ (Lambda x e)) = (x:xs,e')
144− where (xs,e') = getLambdas e
145−getLambdas e = ([],e)
146−
147−needsParens e =
148− case e of
149− Binop _ _ _ -> True
150− Lambda _ _ -> True
151− App _ _ -> True
152− MultiIf _ -> True
153− Let _ _ -> True
154− Case _ _ -> True
155− Data name (x:xs) -> name /= "Cons"
156− _ -> False