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