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